import qualified Maybe
import qualified Data.Either as Either
import Data.Accessor
+import Data.Accessor.MonadState as MonadState
import Debug.Trace
-- ForSyDe
genFCall' switch (Left res) f args = do
let fname = varToString f
let el_ty = if switch then (Var.varType res) else ((tfvec_elem . Var.varType) res)
- id <- vectorFunId el_ty fname
+ id <- MonadState.lift vsType $ vectorFunId el_ty fname
return $ AST.PrimFCall $ AST.FCall (AST.NSimple id) $
map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
genFCall' _ (Right name) _ _ = error $ "\nGenerate.genFCall': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
+genFromSizedWord :: BuiltinBuilder
+genFromSizedWord = genExprArgs $ genExprRes genFromSizedWord'
+genFromSizedWord' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
+genFromSizedWord' (Left res) f args = do
+ let fname = varToString f
+ return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId toIntegerId)) $
+ map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
+genFromSizedWord' (Right name) _ _ = error $ "\nGenerate.genFromSizedWord': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
+
+
-- | Generate a generate statement for the builtin function "map"
genMap :: BuiltinBuilder
genMap (Left res) f [Left mapped_f, Left (Var arg)] =
-- temporary vector
let tmp_ty = Type.mkAppTy nvec (Var.varType start)
let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
- tmp_vhdl_ty <- vhdl_ty error_msg tmp_ty
+ tmp_vhdl_ty <- MonadState.lift vsType $ vhdl_ty error_msg tmp_ty
-- Setup the generate scheme
let gen_label = mkVHDLExtId ("foldlVector" ++ (varToString vec))
let block_label = mkVHDLExtId ("foldlVector" ++ (varToString start))
argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
in do
- labels <- getFieldLabels (tfvec_elem (Var.varType res))
+ labels <- MonadState.lift vsType $ getFieldLabels (tfvec_elem (Var.varType res))
let resnameA = mkSelectedName resname' (labels!!0)
let resnameB = mkSelectedName resname' (labels!!1)
let resA_assign = mkUncondAssign (Right resnameA) argexpr1
resname' = varToVHDLName res
argexpr' = mkIndexedName (varToVHDLName arg) n_expr
in do
- reslabels <- getFieldLabels (Var.varType res)
- arglabels <- getFieldLabels (tfvec_elem (Var.varType arg))
+ reslabels <- MonadState.lift vsType $ getFieldLabels (Var.varType res)
+ arglabels <- MonadState.lift vsType $ 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)
-- -- temporary vector
let tmp_ty = Var.varType res
let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString tmp_ty
- tmp_vhdl_ty <- vhdl_ty error_msg tmp_ty
+ tmp_vhdl_ty <- MonadState.lift vsType $ vhdl_ty error_msg tmp_ty
-- Setup the generate scheme
let gen_label = mkVHDLExtId ("iterateVector" ++ (varToString start))
let block_label = mkVHDLExtId ("iterateVector" ++ (varToString res))
-- It's a datacon. Create a record from its arguments.
Left bndr -> do
-- We have the bndr, so we can get at the type
- labels <- getFieldLabels (Var.varType bndr)
+ labels <- MonadState.lift vsType $ getFieldLabels (Var.varType bndr)
return $ zipWith mkassign labels $ map (either exprToVHDLExpr id) args
where
mkassign :: AST.VHDLId -> AST.Expr -> AST.ConcSm
if length args == arg_count then
builder dst f args
else
- error $ "\nGenerate.genApplication: Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
- Nothing -> error $ "\nGenerate.genApplication: Using function from another module that is not a known builtin: " ++ pprString f
+ error $ "\nGenerate.genApplication(VanillaGlobal): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
+ Nothing -> error $ "\nGenerate.genApplication(VanillaGlobal): Using function from another module that is not a known builtin: " ++ pprString f
IdInfo.NotGlobalId -> do
signatures <- getA vsSignatures
-- This is a local id, so it should be a function whose definition we
portmaps = mkAssocElems (map (either exprToVHDLExpr id) args) ((either varToVHDLName id) dst) signature
in
return [mkComponentInst label entity_id portmaps]
+ IdInfo.ClassOpId cls -> do
+ -- FIXME: Not looking for what instance this class op is called for
+ -- Is quite stupid of course.
+ case (Map.lookup (varToString f) globalNameTable) of
+ Just (arg_count, builder) ->
+ if length args == arg_count then
+ builder dst f args
+ else
+ error $ "\nGenerate.genApplication(ClassOpId): Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
+ Nothing -> error $ "\nGenerate.genApplication(ClassOpId): Using function from another module that is not a known builtin: " ++ pprString f
details -> error $ "\nGenerate.genApplication: Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
-----------------------------------------------------------------------------
-- Returns the VHDLId of the vector function with the given name for the given
-- element type. Generates -- this function if needed.
-vectorFunId :: Type.Type -> String -> VHDLSession AST.VHDLId
+vectorFunId :: Type.Type -> String -> TypeSession AST.VHDLId
vectorFunId el_ty fname = do
let error_msg = "\nGenerate.vectorFunId: Can not construct vector function for element: " ++ pprString el_ty
elemTM <- vhdl_ty error_msg el_ty
, (hwandId , (2, genOperator2 AST.And ) )
, (hworId , (2, genOperator2 AST.Or ) )
, (hwnotId , (1, genOperator1 AST.Not ) )
+ , (plusId , (2, genOperator2 (AST.:+:) ) )
+ , (timesId , (2, genOperator2 (AST.:*:) ) )
+ , (negateId , (1, genOperator1 AST.Not ) )
+ , (minusId , (2, genOperator2 (AST.:-:) ) )
+ , (fromSizedWordId , (1, genFromSizedWord ) )
]
projects / matthijs / master-project / cλash.git / blobdiff