-- | 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]
genFoldl :: BuiltinBuilder
genFoldl = genVarArgs genFoldl'
genFoldl' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
+-- Special case for an empty input vector, just assign start to res
+genFoldl' (Left res) _ [_, start, vec] | len == 0 = return [mkUncondAssign (Left res) (varToVHDLExpr start)]
+ where len = (tfvec_len . Var.varType) vec
genFoldl' (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)
-- Return the conditional generate part
return $ AST.GenerateSm cond_label cond_scheme [] app_concsms
+{-
+genFoldr :: BuiltinBuilder
+genFoldr = genVarArgs genFoldr'
+genFoldr' resVal f [folded_f, startVal, inVec] = do
+ signatures <- getA vsSignatures
+ let entity = Maybe.fromMaybe
+ (error $ "Using function '" ++ (varToString folded_f) ++ "' without signature? This should not happen!")
+ (Map.lookup folded_f signatures)
+ let (vec, _) = splitAppTy (Var.varType inVec)
+ let vecty = Type.mkAppTy vec (Var.varType startVal)
+ vecType <- vhdl_ty vecty
+ -- Setup the generate scheme
+ let len = (tfvec_len . Var.varType) inVec
+ let genlabel = mkVHDLExtId ("foldrVector" ++ (varToString inVec))
+ let blockLabel = mkVHDLExtId ("foldrVector" ++ (varToString startVal))
+ let range = AST.DownRange (AST.PrimLit $ show (len-1)) (AST.PrimLit "0")
+ let genScheme = AST.ForGn (AST.unsafeVHDLBasicId "n") range
+ -- Make the intermediate vector
+ let tmpId = mkVHDLExtId "tmp"
+ let tmpVec = AST.BDISD $ AST.SigDec tmpId vecType Nothing
+ -- Get the entity name and port names
+ let entity_id = ent_id entity
+ let argports = map (Monad.liftM fst) (ent_args entity)
+ let resport = (Monad.liftM fst) (ent_res entity)
+ -- Generate the output assignment
+ let assign = [mkUncondAssign (Left resVal) (AST.PrimName (AST.NIndexed (AST.IndexedName
+ (AST.NSimple tmpId) [AST.PrimLit "0"])))]
+ -- Return the generate functions
+ let genSm = AST.CSGSm $ AST.GenerateSm genlabel genScheme []
+ [ AST.CSGSm (genFirstCell len (entity_id, argports, resport)
+ [startVal, inVec, resVal])
+ , AST.CSGSm (genOtherCell len (entity_id, argports, resport)
+ [startVal, inVec, resVal])
+ ]
+ return $ if len > 0 then
+ [AST.CSBSm $ AST.BlockSm blockLabel [] (AST.PMapAspect []) [tmpVec] (genSm : assign)]
+ else
+ [mkUncondAssign (Left resVal) (AST.PrimName $ AST.NSimple (varToVHDLId startVal))]
+ where
+ genFirstCell len (entity_id, argports, resport) [startVal, inVec, resVal] = cellGn
+ where
+ cellLabel = mkVHDLExtId "firstcell"
+ cellGenScheme = AST.IfGn ((AST.PrimName $ AST.NSimple nPar) AST.:=: (AST.PrimLit $ show (len-1)))
+ tmpId = mkVHDLExtId "tmp"
+ nPar = AST.unsafeVHDLBasicId "n"
+ -- Assign the ports
+ inport1 = mkAssocElem (argports!!0) (varToString startVal)
+ inport2 = mkAssocElemIndexed (argports!!1) (varToVHDLId inVec) nPar
+ outport = mkAssocElemIndexed resport tmpId nPar
+ portassigns = Maybe.catMaybes [inport1,inport2,outport]
+ -- Generate the portmap
+ mapLabel = "cell" ++ (AST.fromVHDLId entity_id)
+ compins = mkComponentInst mapLabel entity_id portassigns
+ -- Return the generate functions
+ cellGn = AST.GenerateSm cellLabel cellGenScheme [] [compins]
+ genOtherCell len (entity_id, argports, resport) [startVal, inVec, resVal] = cellGn
+ where
+ len = (tfvec_len . Var.varType) inVec
+ cellLabel = mkVHDLExtId "othercell"
+ cellGenScheme = AST.IfGn ((AST.PrimName $ AST.NSimple nPar) AST.:/=: (AST.PrimLit $ show (len-1)))
+ -- ((AST.PrimName $ AST.NSimple nPar) AST.:<: (AST.PrimLit $ show (len-1)))
+ tmpId = mkVHDLExtId "tmp"
+ nPar = AST.unsafeVHDLBasicId "n"
+ -- Assign the ports
+ inport1 = mkAssocElemIndexed (argports!!0) tmpId (AST.unsafeVHDLBasicId "n+1")
+ inport2 = mkAssocElemIndexed (argports!!1) (varToVHDLId inVec) nPar
+ outport = mkAssocElemIndexed resport tmpId nPar
+ portassigns = Maybe.catMaybes [inport1,inport2,outport]
+ -- Generate the portmap
+ mapLabel = "cell" ++ (AST.fromVHDLId entity_id)
+ compins = mkComponentInst mapLabel entity_id portassigns
+ -- Return the generate functions
+ cellGn = AST.GenerateSm cellLabel cellGenScheme [] [compins]
+
+-}
+
+
-----------------------------------------------------------------------------
-- Function to generate VHDL for applications
-----------------------------------------------------------------------------
, (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