projects
/
matthijs
/
master-project
/
cλash.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
ca2ff67
)
Fix bug with generating head and tail functions. Update builtin resize function
author
Christiaan Baaij
<christiaan.baaij@gmail.com>
Wed, 23 Sep 2009 12:29:57 +0000
(14:29 +0200)
committer
Christiaan Baaij
<christiaan.baaij@gmail.com>
Wed, 23 Sep 2009 12:29:57 +0000
(14:29 +0200)
cλash/CLasH/Translator/TranslatorTypes.hs
patch
|
blob
|
history
cλash/CLasH/VHDL/Constants.hs
patch
|
blob
|
history
cλash/CLasH/VHDL/Generate.hs
patch
|
blob
|
history
cλash/CLasH/VHDL/VHDLTools.hs
patch
|
blob
|
history
diff --git
a/cλash/CLasH/Translator/TranslatorTypes.hs
b/cλash/CLasH/Translator/TranslatorTypes.hs
index c9c94055a199a124ab34588cd10f14f3f1f70fa0..ee2220d0a4ece1ff6de9e2cfcd9ad193615a5b81 100644
(file)
--- a/
cλash/CLasH/Translator/TranslatorTypes.hs
+++ b/
cλash/CLasH/Translator/TranslatorTypes.hs
@@
-61,7
+61,7
@@
type TypeMap = Map.Map HType (Maybe (AST.VHDLId, Either AST.TypeDef AST.SubtypeI
-- A map of a vector Core element type and function name to the coressponding
-- VHDLId of the function and the function body.
-- A map of a vector Core element type and function name to the coressponding
-- VHDLId of the function and the function body.
-type TypeFunMap = Map.Map (
Ord
Type, String) (AST.VHDLId, AST.SubProgBody)
+type TypeFunMap = Map.Map (
H
Type, String) (AST.VHDLId, AST.SubProgBody)
type TfpIntMap = Map.Map OrdType Int
-- A substate that deals with type generation
type TfpIntMap = Map.Map OrdType Int
-- A substate that deals with type generation
diff --git
a/cλash/CLasH/VHDL/Constants.hs
b/cλash/CLasH/VHDL/Constants.hs
index 03688eb01a132eed54233a00088719dff82f2d13..54a294115f9308dce7ece44404d90a06b328d08a 100644
(file)
--- a/
cλash/CLasH/VHDL/Constants.hs
+++ b/
cλash/CLasH/VHDL/Constants.hs
@@
-297,6
+297,12
@@
toUnsignedId = "to_unsigned"
resizeId :: String
resizeId = "resize"
resizeId :: String
resizeId = "resize"
+resizeWordId :: String
+resizeWordId = "resizeWord"
+
+resizeIntId :: String
+resizeIntId = "resizeInt"
+
smallIntegerId :: String
smallIntegerId = "smallInteger"
smallIntegerId :: String
smallIntegerId = "smallInteger"
diff --git
a/cλash/CLasH/VHDL/Generate.hs
b/cλash/CLasH/VHDL/Generate.hs
index 99f798f47e72a91a23cb28c2610e06f05b2bde4c..70b82a4c391fdf57a3c1a260b44276cb7e457223 100644
(file)
--- a/
cλash/CLasH/VHDL/Generate.hs
+++ b/
cλash/CLasH/VHDL/Generate.hs
@@
-1015,7
+1015,7
@@
vectorFunId el_ty fname = do
-- the VHDLState or something.
let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM)
typefuns <- getA tsTypeFuns
-- the VHDLState or something.
let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM)
typefuns <- getA tsTypeFuns
- case Map.lookup (OrdType el_ty, fname) typefuns of
+ case Map.lookup (
StdType $
OrdType el_ty, fname) typefuns of
-- Function already generated, just return it
Just (id, _) -> return id
-- Function not generated yet, generate it
-- Function already generated, just return it
Just (id, _) -> return id
-- Function not generated yet, generate it
@@
-1023,7
+1023,7
@@
vectorFunId el_ty fname = do
let functions = genUnconsVectorFuns elemTM vectorTM
case lookup fname functions of
Just body -> do
let functions = genUnconsVectorFuns elemTM vectorTM
case lookup fname functions of
Just body -> do
- modA tsTypeFuns $ Map.insert (OrdType el_ty, fname) (function_id, (fst body))
+ modA tsTypeFuns $ Map.insert (
StdType $
OrdType el_ty, fname) (function_id, (fst body))
mapM_ (vectorFunId el_ty) (snd body)
return function_id
Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname
mapM_ (vectorFunId el_ty) (snd body)
return function_id
Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname
@@
-1469,7
+1469,8
@@
globalNameTable = Map.fromList
, (minusId , (2, genOperator2 (AST.:-:) ) )
, (fromSizedWordId , (1, genFromSizedWord ) )
, (fromIntegerId , (1, genFromInteger ) )
, (minusId , (2, genOperator2 (AST.:-:) ) )
, (fromSizedWordId , (1, genFromSizedWord ) )
, (fromIntegerId , (1, genFromInteger ) )
- , (resizeId , (1, genResize ) )
+ , (resizeWordId , (1, genResize ) )
+ , (resizeIntId , (1, genResize ) )
, (sizedIntId , (1, genSizedInt ) )
, (smallIntegerId , (1, genFromInteger ) )
, (fstId , (1, genFst ) )
, (sizedIntId , (1, genSizedInt ) )
, (smallIntegerId , (1, genFromInteger ) )
, (fstId , (1, genFst ) )
diff --git
a/cλash/CLasH/VHDL/VHDLTools.hs
b/cλash/CLasH/VHDL/VHDLTools.hs
index b16da44e6f1cd2c3b7653afbbfcd7263618468c7..edca0c306325bea654e9eaa86b71ba9afdeea112 100644
(file)
--- a/
cλash/CLasH/VHDL/VHDLTools.hs
+++ b/
cλash/CLasH/VHDL/VHDLTools.hs
@@
-413,7
+413,8
@@
mk_tycon_ty ty tycon args =
let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon) ++ elem_names
let ty_def = AST.TDR $ AST.RecordTypeDef elems
let tupshow = mkTupleShow elem_tys ty_id
let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon) ++ elem_names
let ty_def = AST.TDR $ AST.RecordTypeDef elems
let tupshow = mkTupleShow elem_tys ty_id
- modA tsTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, tupshow)
+ let htype = ADTType (nameToString (TyCon.tyConName tycon)) (map (\x -> StdType (OrdType x)) real_arg_tys)
+ modA tsTypeFuns $ Map.insert (htype, showIdString) (showId, tupshow)
return $ Right $ Just (ty_id, Left ty_def)
-- There were errors in element types
(errors, _) -> return $ Left $
return $ Right $ Just (ty_id, Left ty_def)
-- There were errors in element types
(errors, _) -> return $ Left $
@@
-428,7
+429,8
@@
mk_tycon_ty ty tycon args =
let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon)
let ty_def = AST.TDE $ AST.EnumTypeDef elems
let enumShow = mkEnumShow elems ty_id
let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon)
let ty_def = AST.TDE $ AST.EnumTypeDef elems
let enumShow = mkEnumShow elems ty_id
- modA tsTypeFuns $ Map.insert (OrdType ty, showIdString) (showId, enumShow)
+ let htype = EnumType (nameToString (TyCon.tyConName tycon)) (map (nameToString . DataCon.dataConName) dcs)
+ modA tsTypeFuns $ Map.insert (htype, showIdString) (showId, enumShow)
return $ Right $ Just (ty_id, Left ty_def)
xs -> return $ Left $
"VHDLTools.mkTyConHType: Only enum-like constructor datatypes supported: " ++ pprString dcs ++ "\n"
return $ Right $ Just (ty_id, Left ty_def)
xs -> return $ Left $
"VHDLTools.mkTyConHType: Only enum-like constructor datatypes supported: " ++ pprString dcs ++ "\n"
@@
-472,7
+474,7
@@
mk_vector_ty ty = do
modA tsTypes (Map.insert (StdType $ OrdType vec_ty) (Just (vec_id, (Left vec_def))))
modA tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Left vec_def))])
let vecShowFuns = mkVectorShow el_ty_tm vec_id
modA tsTypes (Map.insert (StdType $ OrdType vec_ty) (Just (vec_id, (Left vec_def))))
modA tsTypeDecls (\typedefs -> typedefs ++ [mktydecl (vec_id, (Left vec_def))])
let vecShowFuns = mkVectorShow el_ty_tm vec_id
- mapM_ (\(id, subprog) -> modA tsTypeFuns $ Map.insert (
OrdType vec
_ty, id) ((mkVHDLExtId id), subprog)) vecShowFuns
+ mapM_ (\(id, subprog) -> modA tsTypeFuns $ Map.insert (
StdType $ OrdType el
_ty, id) ((mkVHDLExtId id), subprog)) vecShowFuns
let ty_def = AST.SubtypeIn vec_id (Just range)
return (Right $ Just (ty_id, Right ty_def))
-- Empty element type? Empty vector type then. TODO: Does this make sense?
let ty_def = AST.SubtypeIn vec_id (Just range)
return (Right $ Just (ty_id, Right ty_def))
-- Empty element type? Empty vector type then. TODO: Does this make sense?