Fix bug with generating head and tail functions. Update builtin resize function

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.
-type TypeFunMap = Map.Map (OrdType, String) (AST.VHDLId, AST.SubProgBody)
+type TypeFunMap = Map.Map (HType, String) (AST.VHDLId, AST.SubProgBody)
 
 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"
 
+resizeWordId :: String
+resizeWordId = "resizeWord"
+
+resizeIntId :: String
+resizeIntId = "resizeInt"
+
 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
-  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
@@ -1023,7 +1023,7 @@ vectorFunId el_ty fname = 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
@@ -1469,7 +1469,8 @@ globalNameTable = Map.fromList
   , (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                  ) )

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
-              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 $
@@ -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
-          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"
@@ -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
-          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?