From: Christiaan Baaij Date: Wed, 23 Sep 2009 12:29:57 +0000 (+0200) Subject: Fix bug with generating head and tail functions. Update builtin resize function X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=60afa8f89d02ac5818d525d6209efe703cc22086;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git Fix bug with generating head and tail functions. Update builtin resize function --- diff --git "a/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" "b/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" index c9c9405..ee2220d 100644 --- "a/c\316\273ash/CLasH/Translator/TranslatorTypes.hs" +++ "b/c\316\273ash/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\316\273ash/CLasH/VHDL/Constants.hs" "b/c\316\273ash/CLasH/VHDL/Constants.hs" index 03688eb..54a2941 100644 --- "a/c\316\273ash/CLasH/VHDL/Constants.hs" +++ "b/c\316\273ash/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\316\273ash/CLasH/VHDL/Generate.hs" "b/c\316\273ash/CLasH/VHDL/Generate.hs" index 99f798f..70b82a4 100644 --- "a/c\316\273ash/CLasH/VHDL/Generate.hs" +++ "b/c\316\273ash/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\316\273ash/CLasH/VHDL/VHDLTools.hs" "b/c\316\273ash/CLasH/VHDL/VHDLTools.hs" index b16da44..edca0c3 100644 --- "a/c\316\273ash/CLasH/VHDL/VHDLTools.hs" +++ "b/c\316\273ash/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?