From: Christiaan Baaij 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