From: Christiaan Baaij <christiaan.baaij@gmail.com>
Date: Mon, 29 Jun 2009 15:17:50 +0000 (+0200)
Subject: Added support for copyn and copy
X-Git-Url: https://git.stderr.nl/gitweb?a=commitdiff_plain;h=774c352cc8eb496df66e80ca1602f865b5ced2b8;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

Added support for copyn and copy
---

diff --git a/Constants.hs b/Constants.hs
index 1637d58..9a3c4dd 100644
--- a/Constants.hs
+++ b/Constants.hs
@@ -157,6 +157,10 @@ reverseId = "reverse"
 copyId :: String
 copyId = "copy"
 
+-- | copyn function identifier
+copynId :: String
+copynId = "copyn"
+
 -- | map function identifier
 mapId :: String
 mapId = "map"
diff --git a/Generate.hs b/Generate.hs
index e6a5d45..f049d40 100644
--- a/Generate.hs
+++ b/Generate.hs
@@ -280,6 +280,19 @@ genUnzip' (Left res) f args@[arg] =
     -- Return the generate functions
     return [AST.CSGSm $ AST.GenerateSm label genScheme [] [resA_assign,resB_assign]]
 
+genCopy :: BuiltinBuilder 
+genCopy = genVarArgs genCopy'
+genCopy' :: (Either CoreSyn.CoreBndr AST.VHDLName ) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
+genCopy' (Left res) f args@[arg] =
+  let
+    resExpr = AST.Aggregate [AST.ElemAssoc (Just AST.Others) 
+                (AST.PrimName $ (varToVHDLName arg))]
+    out_assign = mkUncondAssign (Left res) resExpr
+  in 
+    return [out_assign]
+    
+    
+
 -----------------------------------------------------------------------------
 -- Function to generate VHDL for applications
 -----------------------------------------------------------------------------
@@ -374,7 +387,7 @@ genUnconsVectorFuns elemTM vectorTM  =
   , (plusgtId, AST.SubProgBody plusgtSpec  [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet])
   , (emptyId, AST.SubProgBody emptySpec   [AST.SPCD emptyVar] [emptyExpr])
   , (singletonId, AST.SubProgBody singletonSpec [AST.SPVD singletonVar] [singletonRet])
-  , (copyId, AST.SubProgBody copySpec    [AST.SPVD copyVar]      [copyExpr])
+  , (copynId, AST.SubProgBody copynSpec    [AST.SPVD copynVar]      [copynExpr])
   , (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])
@@ -538,10 +551,10 @@ genUnconsVectorFuns elemTM vectorTM  =
              (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others) 
                                           (AST.PrimName $ AST.NSimple aPar)])
     singletonRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
-    copySpec = AST.Function (mkVHDLExtId copyId) [AST.IfaceVarDec nPar   naturalTM,
+    copynSpec = AST.Function (mkVHDLExtId copynId) [AST.IfaceVarDec nPar   naturalTM,
                                    AST.IfaceVarDec aPar   elemTM   ] vectorTM 
     -- variable res : fsvec_x (0 to n-1) := (others => a);
-    copyVar = 
+    copynVar = 
       AST.VarDec resId 
              (AST.SubtypeIn vectorTM
                (Just $ AST.ConstraintIndex $ AST.IndexConstraint 
@@ -551,7 +564,7 @@ genUnconsVectorFuns elemTM vectorTM  =
              (Just $ AST.Aggregate [AST.ElemAssoc (Just AST.Others) 
                                           (AST.PrimName $ AST.NSimple aPar)])
     -- return res
-    copyExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+    copynExpr = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
     selSpec = AST.Function (mkVHDLExtId selId) [AST.IfaceVarDec fPar   naturalTM,
                                AST.IfaceVarDec sPar   naturalTM,
                                AST.IfaceVarDec nPar   naturalTM,
@@ -615,7 +628,7 @@ genUnconsVectorFuns elemTM vectorTM  =
     lengthTSpec = AST.Function (mkVHDLExtId lengthTId) [AST.IfaceVarDec vecPar vectorTM] naturalTM
     lengthTExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NAttribute $ 
                                 AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing))
-
+                                
 -----------------------------------------------------------------------------
 -- A table of builtin functions
 -----------------------------------------------------------------------------
@@ -644,7 +657,8 @@ globalNameTable = Map.fromList
   , (unzipId          , (1, genUnzip                ) )
   , (emptyId          , (0, genFCall                ) )
   , (singletonId      , (1, genFCall                ) )
-  , (copyId           , (2, genFCall                ) )
+  , (copynId          , (2, genFCall                ) )
+  , (copyId           , (1, genCopy                 ) )
   , (lengthTId        , (1, genFCall                ) )
   , (hwxorId          , (2, genOperator2 AST.Xor    ) )
   , (hwandId          , (2, genOperator2 AST.And    ) )
diff --git a/HighOrdAlu.hs b/HighOrdAlu.hs
index d453f64..f7d4516 100644
--- a/HighOrdAlu.hs
+++ b/HighOrdAlu.hs
@@ -8,9 +8,9 @@ import Types
 import Data.Param.TFVec
 import Data.RangedWord
 
-constant :: e -> Op D4 e
+constant :: NaturalT n => e -> Op n e
 constant e a b =
-  copy (lengthT a) e
+  copy e
 
 invop :: Op n Bit
 invop a b = map hwnot a
@@ -20,7 +20,7 @@ andop a b = zipWith hwand a b
 
 -- Is any bit set?
 --anyset :: (PositiveT n) => Op n Bit
-anyset :: Op D4 Bit
+anyset :: NaturalT n => Op n Bit
 --anyset a b = copy undefined (a' `hwor` b')
 anyset a b = constant (a' `hwor` b') a b
   where