From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Mon, 29 Jun 2009 09:02:31 +0000 (+0200)
Subject: Added unzip
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=51213c2cae12b73b46eaf607a0ca1a6586644d73;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Added unzip

Added typenames to typlerecordname to make unique id's
---

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