X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Generate.hs;h=691a27d06e39f9a3080954c9117ab7972e50fe4a;hb=1476a5bd6c7c174ffbd39a178caa9701bdd39ac1;hp=0a9e9b590eab31c3157c3b6c5ac807beabcef163;hpb=c154f599b83d1a91e99993666139e01f10033d5c;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/Generate.hs b/Generate.hs
index 0a9e9b5..691a27d 100644
--- a/Generate.hs
+++ b/Generate.hs
@@ -222,6 +222,32 @@ genFold' left (Left res) f [folded_f, start, vec] = do
       -- Return the conditional generate part
       return $ AST.GenerateSm cond_label cond_scheme [] app_concsms
 
+-- | Generate a generate statement for the builtin function "zip"
+genZip :: BuiltinBuilder
+genZip = genVarArgs genZip'
+genZip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
+genZip' (Left res) f args@[arg1, arg2] =
+  let
+    -- Setup the generate scheme
+    len             = (tfvec_len . Var.varType) res
+    -- TODO: Use something better than varToString
+    label           = mkVHDLExtId ("zipVector" ++ (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'        = mkIndexedName (varToVHDLName res) n_expr
+    argexpr1        = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
+    argexpr2        = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
+  in do
+    labels <- getFieldLabels (tfvec_elem (Var.varType res))
+    let resnameA    = mkSelectedName resname' (labels!!0)
+    let resnameB    = mkSelectedName resname' (labels!!1)
+    let resA_assign = mkUncondAssign (Right resnameA) argexpr1
+    let resB_assign = mkUncondAssign (Right resnameB) argexpr2
+    -- Return the generate functions
+    return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
+
 -----------------------------------------------------------------------------
 -- Function to generate VHDL for applications
 -----------------------------------------------------------------------------
@@ -318,10 +344,14 @@ genUnconsVectorFuns elemTM vectorTM  =
   , (singletonId, AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet])
   , (copyId, AST.SubProgBody copySpec    [AST.SPVD copyVar]      [copyExpr])
   , (selId, AST.SubProgBody selSpec  [AST.SPVD selVar] [selFor, selRet])
+  , (ltplusId, AST.SubProgBody ltplusSpec [AST.SPVD ltplusVar] [ltplusExpr, ltplusRet]  )  
+  , (plusplusId, AST.SubProgBody plusplusSpec [AST.SPVD plusplusVar] [plusplusExpr, plusplusRet])
   ]
   where 
     ixPar   = AST.unsafeVHDLBasicId "ix"
     vecPar  = AST.unsafeVHDLBasicId "vec"
+    vec1Par = AST.unsafeVHDLBasicId "vec1"
+    vec2Par = AST.unsafeVHDLBasicId "vec2"
     nPar    = AST.unsafeVHDLBasicId "n"
     iId     = AST.unsafeVHDLBasicId "i"
     iPar    = iId
@@ -515,6 +545,40 @@ genUnconsVectorFuns elemTM vectorTM  =
                                     (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar) [origExp]))
     -- return res;
     selRet =  AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
+    ltplusSpec = AST.Function (mkVHDLExtId ltplusId) [AST.IfaceVarDec vecPar vectorTM,
+                                        AST.IfaceVarDec aPar   elemTM] vectorTM 
+     -- variable res : fsvec_x (0 to vec'length);
+    ltplusVar = 
+      AST.VarDec resId 
+        (AST.SubtypeIn vectorTM
+          (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
+            [AST.ToRange (AST.PrimLit "0")
+              (AST.PrimName (AST.NAttribute $ 
+                AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing))]))
+        Nothing
+    ltplusExpr = AST.NSimple resId AST.:= 
+                     ((AST.PrimName $ AST.NSimple vecPar) AST.:&: 
+                      (AST.PrimName $ AST.NSimple aPar))
+    ltplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+    plusplusSpec = AST.Function (mkVHDLExtId plusplusId) [AST.IfaceVarDec vec1Par vectorTM,
+                                             AST.IfaceVarDec vec2Par vectorTM] 
+                                             vectorTM 
+    -- variable res : fsvec_x (0 to vec1'length + vec2'length -1);
+    plusplusVar = 
+      AST.VarDec resId 
+        (AST.SubtypeIn vectorTM
+          (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
+            [AST.ToRange (AST.PrimLit "0")
+              (AST.PrimName (AST.NAttribute $ 
+                AST.AttribName (AST.NSimple vec1Par) (mkVHDLBasicId lengthId) Nothing) AST.:+:
+                  AST.PrimName (AST.NAttribute $ 
+                AST.AttribName (AST.NSimple vec2Par) (mkVHDLBasicId lengthId) Nothing) AST.:-:
+                  AST.PrimLit "1")]))
+       Nothing
+    plusplusExpr = AST.NSimple resId AST.:= 
+                     ((AST.PrimName $ AST.NSimple vec1Par) AST.:&: 
+                      (AST.PrimName $ AST.NSimple vec2Par))
+    plusplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
 
 -----------------------------------------------------------------------------
 -- A table of builtin functions
@@ -534,10 +598,13 @@ globalNameTable = Map.fromList
   , (dropId           , (2, genFCall                ) )
   , (selId            , (4, genFCall                ) )
   , (plusgtId         , (2, genFCall                ) )
+  , (ltplusId         , (2, genFCall                ) )
+  , (plusplusId       , (2, genFCall                ) )
   , (mapId            , (2, genMap                  ) )
   , (zipWithId        , (3, genZipWith              ) )
   , (foldlId          , (3, genFoldl                ) )
   , (foldrId          , (3, genFoldr                ) )
+  , (zipId            , (2, genZip                  ) )
   , (emptyId          , (0, genFCall                ) )
   , (singletonId      , (1, genFCall                ) )
   , (copyId           , (2, genFCall                ) )