return [AST.CSGSm $ AST.GenerateSm label genScheme [] app_concsms]
genFoldl :: BuiltinBuilder
-genFoldl = genVarArgs genFoldl'
-genFoldl' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
-genFoldl' (Left res) f [folded_f, start, vec] = do
+genFoldl = genFold True
+
+genFoldr :: BuiltinBuilder
+genFoldr = genFold False
+
+genFold :: Bool -> BuiltinBuilder
+genFold left = genVarArgs (genFold' left)
+genFold' :: Bool -> (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
+-- Special case for an empty input vector, just assign start to res
+genFold' left (Left res) _ [_, start, vec] | len == 0 = return [mkUncondAssign (Left res) (varToVHDLExpr start)]
+ where len = (tfvec_len . Var.varType) vec
+genFold' left (Left res) f [folded_f, start, vec] = do
-- evec is (TFVec n), so it still needs an element type
let (nvec, _) = splitAppTy (Var.varType vec)
-- Put the type of the start value in nvec, this will be the type of our
-- Setup the generate scheme
let gen_label = mkVHDLExtId ("foldlVector" ++ (varToString vec))
let block_label = mkVHDLExtId ("foldlVector" ++ (varToString start))
- let gen_range = AST.ToRange (AST.PrimLit "0") len_min_expr
+ let gen_range = if left then AST.ToRange (AST.PrimLit "0") len_min_expr
+ else AST.DownRange len_min_expr (AST.PrimLit "0")
let gen_scheme = AST.ForGn n_id gen_range
-- Make the intermediate vector
let tmp_dec = AST.BDISD $ AST.SigDec tmp_id tmp_vhdl_ty Nothing
-- Create the generate statement
cells <- sequence [genFirstCell, genOtherCell]
let gen_sm = AST.GenerateSm gen_label gen_scheme [] (map AST.CSGSm cells)
- -- Assign tmp[len-1] to res
- let out_assign = mkUncondAssign (Left res) $ vhdlNameToVHDLExpr (mkIndexedName tmp_name (AST.PrimLit $ show (len-1)))
+ -- Assign tmp[len-1] or tmp[0] to res
+ let out_assign = mkUncondAssign (Left res) $ vhdlNameToVHDLExpr (if left then
+ (mkIndexedName tmp_name (AST.PrimLit $ show (len-1))) else
+ (mkIndexedName tmp_name (AST.PrimLit "0")))
let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
return [AST.CSBSm block]
where
len = (tfvec_len . Var.varType) vec
-- An id for the counter
n_id = mkVHDLBasicId "n"
- n_expr = idToVHDLExpr n_id
- -- An expression for n-1
- n_min_expr = n_expr AST.:-: (AST.PrimLit "1")
+ n_cur = idToVHDLExpr n_id
+ -- An expression for previous n
+ n_prev = if left then (n_cur AST.:-: (AST.PrimLit "1"))
+ else (n_cur AST.:+: (AST.PrimLit "1"))
-- An expression for len-1
len_min_expr = (AST.PrimLit $ show (len-1))
-- An id for the tmp result vector
genFirstCell, genOtherCell :: VHDLSession AST.GenerateSm
genFirstCell = do
let cond_label = mkVHDLExtId "firstcell"
- -- if n == 0
- let cond_scheme = AST.IfGn $ n_expr AST.:=: (AST.PrimLit "0")
- -- Output to tmp[n]
- let resname = mkIndexedName tmp_name n_expr
+ -- if n == 0 or n == len-1
+ let cond_scheme = AST.IfGn $ n_cur AST.:=: (if left then (AST.PrimLit "0")
+ else (AST.PrimLit $ show (len-1)))
+ -- Output to tmp[current n]
+ let resname = mkIndexedName tmp_name n_cur
-- Input from start
let argexpr1 = varToVHDLExpr start
- -- Input from vec[n]
- let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_expr
- app_concsms <- genApplication (Right resname) folded_f [Right argexpr1, Right argexpr2]
+ -- Input from vec[current n]
+ let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur
+ app_concsms <- genApplication (Right resname) folded_f ( if left then
+ [Right argexpr1, Right argexpr2]
+ else
+ [Right argexpr2, Right argexpr1]
+ )
-- Return the conditional generate part
return $ AST.GenerateSm cond_label cond_scheme [] app_concsms
genOtherCell = do
let cond_label = mkVHDLExtId "othercell"
- -- if n > 0
- let cond_scheme = AST.IfGn $ n_expr AST.:>: (AST.PrimLit "0")
- -- Output to tmp[n]
- let resname = mkIndexedName tmp_name n_expr
- -- Input from tmp[n-1]
- let argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_min_expr
- -- Input from vec[n]
- let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_expr
- app_concsms <- genApplication (Right resname) folded_f [Right argexpr1, Right argexpr2]
+ -- if n > 0 or n < len-1
+ let cond_scheme = AST.IfGn $ n_cur AST.:/=: (if left then (AST.PrimLit "0")
+ else (AST.PrimLit $ show (len-1)))
+ -- Output to tmp[current n]
+ let resname = mkIndexedName tmp_name n_cur
+ -- Input from tmp[previous n]
+ let argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
+ -- Input from vec[current n]
+ let argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName vec) n_cur
+ app_concsms <- genApplication (Right resname) folded_f ( if left then
+ [Right argexpr1, Right argexpr2]
+ else
+ [Right argexpr2, Right argexpr1]
+ )
-- Return the conditional generate part
return $ AST.GenerateSm cond_label cond_scheme [] app_concsms
entity_id = ent_id signature
-- TODO: Using show here isn't really pretty, but we'll need some
-- unique-ish value...
- label = "comp_ins_" ++ (either show show) dst
+ label = "comp_ins_" ++ (either show prettyShow) dst
portmaps = mkAssocElems (map (either exprToVHDLExpr id) args) ((either varToVHDLName id) dst) signature
in
return [mkComponentInst label entity_id portmaps]
, (emptyId, AST.SubProgBody emptySpec [AST.SPCD emptyVar] [emptyExpr])
, (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])
]
where
ixPar = AST.unsafeVHDLBasicId "ix"
iId = AST.unsafeVHDLBasicId "i"
iPar = iId
aPar = AST.unsafeVHDLBasicId "a"
+ fPar = AST.unsafeVHDLBasicId "f"
+ sPar = AST.unsafeVHDLBasicId "s"
resId = AST.unsafeVHDLBasicId "res"
exSpec = AST.Function (mkVHDLExtId exId) [AST.IfaceVarDec vecPar vectorTM,
AST.IfaceVarDec ixPar naturalTM] elemTM
(AST.PrimName $ AST.NSimple aPar)])
-- return res
copyExpr = 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.IfaceVarDec vecPar vectorTM ] vectorTM
+ -- variable res : fsvec_x (0 to n-1);
+ selVar =
+ AST.VarDec resId
+ (AST.SubtypeIn vectorTM
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
+ [AST.ToRange (AST.PrimLit "0")
+ ((AST.PrimName (AST.NSimple nPar)) AST.:-:
+ (AST.PrimLit "1")) ])
+ )
+ Nothing
+ -- for i res'range loop
+ -- res(i) := vec(f+i*s);
+ -- end loop;
+ selFor = AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) rangeId Nothing) [selAssign]
+ -- res(i) := vec(f+i*s);
+ selAssign = let origExp = AST.PrimName (AST.NSimple fPar) AST.:+:
+ (AST.PrimName (AST.NSimple iId) AST.:*:
+ AST.PrimName (AST.NSimple sPar)) in
+ AST.NIndexed (AST.IndexedName (AST.NSimple resId) [AST.PrimName (AST.NSimple iId)]) AST.:=
+ (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar) [origExp]))
+ -- return res;
+ selRet = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
-----------------------------------------------------------------------------
-- A table of builtin functions
, (initId , (1, genFCall ) )
, (takeId , (2, genFCall ) )
, (dropId , (2, genFCall ) )
+ , (selId , (4, genFCall ) )
, (plusgtId , (2, genFCall ) )
, (mapId , (2, genMap ) )
, (zipWithId , (3, genZipWith ) )
, (foldlId , (3, genFoldl ) )
+ , (foldrId , (3, genFoldr ) )
, (emptyId , (0, genFCall ) )
, (singletonId , (1, genFCall ) )
, (copyId , (2, genFCall ) )
projects / matthijs / master-project / cλash.git / blobdiff