-- | Generate a generate statement for the builtin function "map"
genMap :: BuiltinBuilder
-genMap = genVarArgs genMap'
-genMap' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
-genMap' (Left res) f [mapped_f, arg] =
+genMap (Left res) f [Left mapped_f, Left (Var arg)] =
+ -- mapped_f must be a CoreExpr (since we can't represent functions as VHDL
+ -- expressions). arg must be a CoreExpr (and should be a CoreSyn.Var), since
+ -- we must index it (which we couldn't if it was a VHDL Expr, since only
+ -- VHDLNames can be indexed).
let
-- Setup the generate scheme
len = (tfvec_len . Var.varType) res
resname = mkIndexedName (varToVHDLName res) n_expr
argexpr = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
in do
- app_concsms <- genApplication (Right resname) mapped_f [Right argexpr]
+ let (CoreSyn.Var real_f, already_mapped_args) = CoreSyn.collectArgs mapped_f
+ let valargs = get_val_args (Var.varType real_f) already_mapped_args
+ app_concsms <- genApplication (Right resname) real_f (map Left valargs ++ [Right argexpr])
-- Return the generate statement
return [AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms]
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]]
+
+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
, (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])
+ , (lengthTId, AST.SubProgBody lengthTSpec [] [lengthTExpr])
]
where
ixPar = AST.unsafeVHDLBasicId "ix"
(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
(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,
((AST.PrimName $ AST.NSimple vec1Par) AST.:&:
(AST.PrimName $ AST.NSimple vec2Par))
plusplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
-
+ 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
-----------------------------------------------------------------------------
, (foldlId , (3, genFoldl ) )
, (foldrId , (3, genFoldr ) )
, (zipId , (2, genZip ) )
+ , (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 ) )
, (hworId , (2, genOperator2 AST.Or ) )
projects / matthijs / master-project / cλash.git / blobdiff