From 51213c2cae12b73b46eaf607a0ca1a6586644d73 Mon Sep 17 00:00:00 2001 From: Christiaan Baaij Date: Mon, 29 Jun 2009 11:02:31 +0200 Subject: [PATCH] Added unzip Added typenames to typlerecordname to make unique id's --- Adders.hs | 4 ++-- Constants.hs | 4 ++++ Generate.hs | 29 +++++++++++++++++++++++++++++ VHDLTools.hs | 3 ++- 4 files changed, 37 insertions(+), 3 deletions(-) diff --git a/Adders.hs b/Adders.hs index b17f744..57823bd 100644 --- a/Adders.hs +++ b/Adders.hs @@ -174,8 +174,8 @@ highordtest = \x -> xand a b = hwand a b -functiontest :: TFVec D4 Bit -> TFVec D4 Bit -> TFVec D4 (Bit, Bit) -functiontest = \v1 v2 -> let r = zip v1 v2 in r +functiontest :: TFVec D4 (Bit, Bit) -> (TFVec D4 Bit, TFVec D4 Bit) +functiontest = \v -> let r = unzip v in r xhwnot x = hwnot x diff --git a/Constants.hs b/Constants.hs index 60aba4e..c538293 100644 --- a/Constants.hs +++ b/Constants.hs @@ -177,6 +177,10 @@ foldrId = "foldr" zipId :: String zipId = "zip" +-- | unzip function identifier +unzipId :: String +unzipId = "unzip" + -- | hwxor function identifier hwxorId :: String hwxorId = "hwxor" diff --git a/Generate.hs b/Generate.hs index 691a27d..7c274e5 100644 --- a/Generate.hs +++ b/Generate.hs @@ -247,6 +247,34 @@ genZip' (Left res) f args@[arg1, arg2] = let resB_assign = mkUncondAssign (Right resnameB) argexpr2 -- Return the generate functions return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]] + +-- | Generate a generate statement for the builtin function "unzip" +genUnzip :: BuiltinBuilder +genUnzip = genVarArgs genUnzip' +genUnzip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm] +genUnzip' (Left res) f args@[arg] = + let + -- Setup the generate scheme + len = (tfvec_len . Var.varType) arg + -- TODO: Use something better than varToString + label = mkVHDLExtId ("unzipVector" ++ (varToString res)) + n_id = mkVHDLBasicId "n" + n_expr = idToVHDLExpr n_id + range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len-1)) + genScheme = AST.ForGn n_id range + resname' = varToVHDLName res + argexpr' = mkIndexedName (varToVHDLName arg) n_expr + in do + reslabels <- getFieldLabels (Var.varType res) + arglabels <- getFieldLabels (tfvec_elem (Var.varType arg)) + let resnameA = mkIndexedName (mkSelectedName resname' (reslabels!!0)) n_expr + let resnameB = mkIndexedName (mkSelectedName resname' (reslabels!!1)) n_expr + let argexprA = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!0) + let argexprB = vhdlNameToVHDLExpr $ mkSelectedName argexpr' (arglabels!!1) + let resA_assign = mkUncondAssign (Right resnameA) argexprA + let resB_assign = mkUncondAssign (Right resnameB) argexprB + -- Return the generate functions + return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]] ----------------------------------------------------------------------------- -- Function to generate VHDL for applications @@ -605,6 +633,7 @@ globalNameTable = Map.fromList , (foldlId , (3, genFoldl ) ) , (foldrId , (3, genFoldr ) ) , (zipId , (2, genZip ) ) + , (unzipId , (1, genUnzip ) ) , (emptyId , (0, genFCall ) ) , (singletonId , (1, genFCall ) ) , (copyId , (2, genFCall ) ) diff --git a/VHDLTools.hs b/VHDLTools.hs index 96a8ae5..0979639 100644 --- a/VHDLTools.hs +++ b/VHDLTools.hs @@ -322,7 +322,8 @@ mk_tycon_ty tycon args = -- each argument. -- TODO: Add argument type ids to this, to ensure uniqueness -- TODO: Special handling for tuples? - let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon) + let elem_names = concat $ map prettyShow elem_tys + let ty_id = mkVHDLExtId $ nameToString (TyCon.tyConName tycon) ++ elem_names let ty_def = AST.TDR $ AST.RecordTypeDef elems return $ Just (ty_id, Left ty_def) dcs -> error $ "Only single constructor datatypes supported: " ++ pprString tycon -- 2.30.2