import qualified Maybe
import qualified Data.Either as Either
import Data.Accessor
+import Data.Accessor.MonadState as MonadState
import Debug.Trace
-- ForSyDe
import Type
import qualified Var
import qualified IdInfo
+import qualified Literal
+import qualified Name
+import qualified TyCon
-- Local imports
import Constants
-- Check (rather crudely) that all arguments are CoreExprs
(exprargs, []) = Either.partitionEithers args
+-- | A function to wrap a builder-like function that expects its arguments to
+-- be Literals
+genLitArgs ::
+ (dst -> func -> [Literal.Literal] -> res)
+ -> (dst -> func -> [Either CoreSyn.CoreExpr AST.Expr] -> res)
+genLitArgs wrap dst func args = wrap dst func args'
+ where
+ args' = map exprToLit litargs
+ -- FIXME: Check if we were passed an CoreSyn.App
+ litargs = concat (map getLiterals exprargs)
+ (exprargs, []) = Either.partitionEithers args
+
-- | A function to wrap a builder-like function that produces an expression
-- and expects it to be assigned to the destination.
genExprRes ::
-- | Generate a function call from the destination binder, function name and a
-- list of expressions (its arguments)
-genFCall :: BuiltinBuilder
-genFCall = genExprArgs $ genExprRes genFCall'
-genFCall' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
-genFCall' (Left res) f args = do
+genFCall :: Bool -> BuiltinBuilder
+genFCall switch = genExprArgs $ genExprRes (genFCall' switch)
+genFCall' :: Bool -> Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [AST.Expr] -> VHDLSession AST.Expr
+genFCall' switch (Left res) f args = do
let fname = varToString f
- let el_ty = (tfvec_elem . Var.varType) res
- id <- vectorFunId el_ty fname
+ let el_ty = if switch then (Var.varType res) else ((tfvec_elem . Var.varType) res)
+ 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 $ "Cannot generate builtin function call assigned to a VHDLName: " ++ show name
+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
+
+-- FIXME: I'm calling genLitArgs which is very specific function,
+-- which needs to be fixed as well
+genFromInteger :: BuiltinBuilder
+genFromInteger = genLitArgs $ genExprRes genFromInteger'
+genFromInteger' :: Either CoreSyn.CoreBndr AST.VHDLName -> CoreSyn.CoreBndr -> [Literal.Literal] -> VHDLSession AST.Expr
+genFromInteger' (Left res) f lits =
+ return $ AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLBasicId fname))
+ [Nothing AST.:=>: AST.ADExpr (AST.PrimLit (show (last lits))), Nothing AST.:=>: AST.ADExpr( AST.PrimLit (show len))]
+ where
+ ty = Var.varType res
+ (tycon, args) = Type.splitTyConApp ty
+ name = Name.getOccString (TyCon.tyConName tycon)
+ len = case name of
+ "SizedInt" -> sized_int_len ty
+ "SizedWord" -> sized_word_len ty
+ fname = case name of
+ "SizedInt" -> toSignedId
+ "SizedWord" -> toUnsignedId
+
+genFromInteger' (Right name) _ _ = error $ "\nGenerate.genFromInteger': Cannot generate builtin function call assigned to a VHDLName: " ++ show name
+
-- | 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]
-genMap' (Right name) _ _ = error $ "Cannot generate map function call assigned to a VHDLName: " ++ show name
+genMap' (Right name) _ _ = error $ "\nGenerate.genMap': Cannot generate map function call assigned to a VHDLName: " ++ show name
genZipWith :: BuiltinBuilder
genZipWith = genVarArgs genZipWith'
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 = 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
-genFoldl' (Left res) _ [_, start, vec] | len == 0 = return [mkUncondAssign (Left res) (varToVHDLExpr start)]
+genFold' left (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
+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
-- temporary vector
let tmp_ty = Type.mkAppTy nvec (Var.varType start)
- tmp_vhdl_ty <- vhdl_ty tmp_ty
+ let error_msg = "\nGenerate.genFold': Can not construct temp vector for element type: " ++ pprString 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))
- 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
-{-
-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
+-- | Generate a generate statement for the builtin function "zip"
+genZip :: BuiltinBuilder
+genZip = genVarArgs genZip'
+genZip' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
+genZip' (Left res) f args@[arg1, arg2] =
+ let
+ -- Setup the generate scheme
+ len = (tfvec_len . Var.varType) res
+ -- TODO: Use something better than varToString
+ label = mkVHDLExtId ("zipVector" ++ (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' = mkIndexedName (varToVHDLName res) n_expr
+ argexpr1 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg1) n_expr
+ argexpr2 = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg2) n_expr
+ in do
+ 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
+ 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 <- 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)
+ 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]
+
+genConcat :: BuiltinBuilder
+genConcat = genVarArgs genConcat'
+genConcat' :: (Either CoreSyn.CoreBndr AST.VHDLName) -> CoreSyn.CoreBndr -> [Var.Var] -> VHDLSession [AST.ConcSm]
+genConcat' (Left res) f args@[arg] =
+ let
+ -- Setup the generate scheme
+ len1 = (tfvec_len . Var.varType) arg
+ (_, nvec) = splitAppTy (Var.varType arg)
+ len2 = tfvec_len nvec
+ -- TODO: Use something better than varToString
+ label = mkVHDLExtId ("concatVector" ++ (varToString res))
+ n_id = mkVHDLBasicId "n"
+ n_expr = idToVHDLExpr n_id
+ fromRange = n_expr AST.:*: (AST.PrimLit $ show len2)
+ genScheme = AST.ForGn n_id range
+ -- Create the content of the generate statement: Applying the mapped_f to
+ -- each of the elements in arg, storing to each element in res
+ toRange = (n_expr AST.:*: (AST.PrimLit $ show len2)) AST.:+: (AST.PrimLit $ show (len2-1))
+ range = AST.ToRange (AST.PrimLit "0") (AST.PrimLit $ show (len1-1))
+ resname = vecSlice fromRange toRange
+ argexpr = vhdlNameToVHDLExpr $ mkIndexedName (varToVHDLName arg) n_expr
+ out_assign = mkUncondAssign (Right resname) argexpr
+ in
+ -- Return the generate statement
+ return [AST.CSGSm $ AST.GenerateSm label genScheme [] [out_assign]]
+ where
+ vecSlice init last = AST.NSlice (AST.SliceName (varToVHDLName res)
+ (AST.ToRange init last))
+
+genIteraten :: BuiltinBuilder
+genIteraten dst f args = genIterate dst f (tail args)
+
+genIterate :: BuiltinBuilder
+genIterate = genIterateOrGenerate True
+
+genGeneraten :: BuiltinBuilder
+genGeneraten dst f args = genGenerate dst f (tail args)
+
+genGenerate :: BuiltinBuilder
+genGenerate = genIterateOrGenerate False
+
+genIterateOrGenerate :: Bool -> BuiltinBuilder
+genIterateOrGenerate iter = genVarArgs (genIterateOrGenerate' iter)
+genIterateOrGenerate' :: 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
+genIterateOrGenerate' iter (Left res) _ [app_f, start] | len == 0 = return [mkUncondAssign (Left res) (AST.PrimLit "\"\"")]
+ where len = (tfvec_len . Var.varType) res
+genIterateOrGenerate' iter (Left res) f [app_f, start] = 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
+ -- -- 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 <- MonadState.lift vsType $ vhdl_ty error_msg tmp_ty
-- 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
+ let gen_label = mkVHDLExtId ("iterateVector" ++ (varToString start))
+ let block_label = mkVHDLExtId ("iterateVector" ++ (varToString res))
+ let gen_range = AST.ToRange (AST.PrimLit "0") len_min_expr
+ let gen_scheme = AST.ForGn n_id gen_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))]
+ 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] or tmp[0] to res
+ let out_assign = mkUncondAssign (Left res) $ vhdlNameToVHDLExpr tmp_name
+ let block = AST.BlockSm block_label [] (AST.PMapAspect []) [tmp_dec] [AST.CSGSm gen_sm, out_assign]
+ return [AST.CSBSm block]
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]
-
--}
+ -- The vector length
+ len = (tfvec_len . Var.varType) res
+ -- An id for the counter
+ n_id = mkVHDLBasicId "n"
+ n_cur = idToVHDLExpr n_id
+ -- An expression for previous n
+ n_prev = 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
+ tmp_id = mkVHDLBasicId "tmp"
+ tmp_name = AST.NSimple tmp_id
+ -- Generate parts of the fold
+ genFirstCell, genOtherCell :: VHDLSession AST.GenerateSm
+ genFirstCell = do
+ let cond_label = mkVHDLExtId "firstcell"
+ -- if n == 0 or n == len-1
+ let cond_scheme = AST.IfGn $ n_cur AST.:=: (AST.PrimLit "0")
+ -- Output to tmp[current n]
+ let resname = mkIndexedName tmp_name n_cur
+ -- Input from start
+ let argexpr = varToVHDLExpr start
+ let startassign = mkUncondAssign (Right resname) argexpr
+ app_concsms <- genApplication (Right resname) app_f [Right argexpr]
+ -- Return the conditional generate part
+ return $ AST.GenerateSm cond_label cond_scheme [] (if iter then
+ [startassign]
+ else
+ app_concsms
+ )
+
+ genOtherCell = do
+ let cond_label = mkVHDLExtId "othercell"
+ -- if n > 0 or n < len-1
+ let cond_scheme = AST.IfGn $ n_cur AST.:/=: (AST.PrimLit "0")
+ -- Output to tmp[current n]
+ let resname = mkIndexedName tmp_name n_cur
+ -- Input from tmp[previous n]
+ let argexpr = vhdlNameToVHDLExpr $ mkIndexedName tmp_name n_prev
+ app_concsms <- genApplication (Right resname) app_f [Right argexpr]
+ -- Return the conditional generate part
+ return $ AST.GenerateSm cond_label cond_scheme [] app_concsms
-----------------------------------------------------------------------------
-- 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
mkassign label arg =
let sel_name = mkSelectedName ((either varToVHDLName id) dst) label in
mkUncondAssign (Right sel_name) arg
- Right _ -> error $ "Generate.genApplication Can't generate dataconstructor application without an original binder"
+ Right _ -> error $ "\nGenerate.genApplication: Can't generate dataconstructor application without an original binder"
IdInfo.VanillaGlobal -> do
-- It's a global value imported from elsewhere. These can be builtin
-- functions. Look up the function name in the name table and execute
if length args == arg_count then
builder dst f args
else
- error $ "Generate.genApplication Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ show args
- Nothing -> error $ "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
-- have and which can be turned into a component instantiation.
let
signature = Maybe.fromMaybe
- (error $ "Using function '" ++ (varToString f) ++ "' without signature? This should not happen!")
+ (error $ "\nGenerate.genApplication: Using function '" ++ (varToString f) ++ "' without signature? This should not happen!")
(Map.lookup f signatures)
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]
- details -> error $ "Calling unsupported function " ++ pprString f ++ " with GlobalIdDetails " ++ pprString details
+ 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
-----------------------------------------------------------------------------
-- Functions to generate functions dealing with vectors.
-- 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
- elemTM <- vhdl_ty el_ty
+ let error_msg = "\nGenerate.vectorFunId: Can not construct vector function for element: " ++ pprString el_ty
+ elemTM <- vhdl_ty error_msg el_ty
-- TODO: This should not be duplicated from mk_vector_ty. Probably but it in
-- the VHDLState or something.
let vectorTM = mkVHDLExtId $ "vector_" ++ (AST.fromVHDLId elemTM)
let functions = genUnconsVectorFuns elemTM vectorTM
case lookup fname functions of
Just body -> do
- modA vsTypeFuns $ Map.insert (OrdType el_ty, fname) (function_id, body)
+ modA vsTypeFuns $ Map.insert (OrdType el_ty, fname) (function_id, (fst body))
+ mapM_ (vectorFunId el_ty) (snd body)
return function_id
- Nothing -> error $ "I don't know how to generate vector function " ++ fname
+ Nothing -> error $ "\nGenerate.vectorFunId: I don't know how to generate vector function " ++ fname
where
function_id = mkVHDLExtId fname
genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
-> AST.TypeMark -- ^ type of the vector
- -> [(String, AST.SubProgBody)]
+ -> [(String, (AST.SubProgBody, [String]))]
genUnconsVectorFuns elemTM vectorTM =
- [ (exId, AST.SubProgBody exSpec [] [exExpr])
- , (replaceId, AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet])
- , (headId, AST.SubProgBody headSpec [] [headExpr])
- , (lastId, AST.SubProgBody lastSpec [] [lastExpr])
- , (initId, AST.SubProgBody initSpec [AST.SPVD initVar] [initExpr, initRet])
- , (tailId, AST.SubProgBody tailSpec [AST.SPVD tailVar] [tailExpr, tailRet])
- , (takeId, AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet])
- , (dropId, AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet])
- , (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])
+ [ (exId, (AST.SubProgBody exSpec [] [exExpr],[]))
+ , (replaceId, (AST.SubProgBody replaceSpec [AST.SPVD replaceVar] [replaceExpr,replaceRet],[]))
+ , (headId, (AST.SubProgBody headSpec [] [headExpr],[]))
+ , (lastId, (AST.SubProgBody lastSpec [] [lastExpr],[]))
+ , (initId, (AST.SubProgBody initSpec [AST.SPVD initVar] [initExpr, initRet],[]))
+ , (tailId, (AST.SubProgBody tailSpec [AST.SPVD tailVar] [tailExpr, tailRet],[]))
+ , (takeId, (AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet],[]))
+ , (dropId, (AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet],[]))
+ , (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],[]))
+ , (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],[]))
+ , (shiftlId, (AST.SubProgBody shiftlSpec [AST.SPVD shiftlVar] [shiftlExpr, shiftlRet], [initId]))
+ , (shiftrId, (AST.SubProgBody shiftrSpec [AST.SPVD shiftrVar] [shiftrExpr, shiftrRet], [tailId]))
+ , (nullId, (AST.SubProgBody nullSpec [] [nullExpr], []))
+ , (rotlId, (AST.SubProgBody rotlSpec [AST.SPVD rotlVar] [rotlExpr, rotlRet], [nullId, lastId, initId]))
+ , (rotrId, (AST.SubProgBody rotrSpec [AST.SPVD rotrVar] [rotrExpr, rotrRet], [nullId, tailId, headId]))
+ , (reverseId, (AST.SubProgBody reverseSpec [AST.SPVD reverseVar] [reverseFor, reverseRet], []))
]
where
ixPar = AST.unsafeVHDLBasicId "ix"
vecPar = AST.unsafeVHDLBasicId "vec"
+ vec1Par = AST.unsafeVHDLBasicId "vec1"
+ vec2Par = AST.unsafeVHDLBasicId "vec2"
nPar = AST.unsafeVHDLBasicId "n"
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
(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.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))
+ ltplusSpec = AST.Function (mkVHDLExtId ltplusId) [AST.IfaceVarDec vecPar vectorTM,
+ AST.IfaceVarDec aPar elemTM] vectorTM
+ -- variable res : fsvec_x (0 to vec'length);
+ ltplusVar =
+ AST.VarDec resId
+ (AST.SubtypeIn vectorTM
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
+ [AST.ToRange (AST.PrimLit "0")
+ (AST.PrimName (AST.NAttribute $
+ AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing))]))
+ Nothing
+ ltplusExpr = AST.NSimple resId AST.:=
+ ((AST.PrimName $ AST.NSimple vecPar) AST.:&:
+ (AST.PrimName $ AST.NSimple aPar))
+ ltplusRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+ plusplusSpec = AST.Function (mkVHDLExtId plusplusId) [AST.IfaceVarDec vec1Par vectorTM,
+ AST.IfaceVarDec vec2Par vectorTM]
+ vectorTM
+ -- variable res : fsvec_x (0 to vec1'length + vec2'length -1);
+ plusplusVar =
+ AST.VarDec resId
+ (AST.SubtypeIn vectorTM
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
+ [AST.ToRange (AST.PrimLit "0")
+ (AST.PrimName (AST.NAttribute $
+ AST.AttribName (AST.NSimple vec1Par) (mkVHDLBasicId lengthId) Nothing) AST.:+:
+ AST.PrimName (AST.NAttribute $
+ AST.AttribName (AST.NSimple vec2Par) (mkVHDLBasicId lengthId) Nothing) AST.:-:
+ AST.PrimLit "1")]))
+ Nothing
+ plusplusExpr = AST.NSimple resId AST.:=
+ ((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))
+ shiftlSpec = AST.Function (mkVHDLExtId shiftlId) [AST.IfaceVarDec vecPar vectorTM,
+ AST.IfaceVarDec aPar elemTM ] vectorTM
+ -- variable res : fsvec_x (0 to vec'length-1);
+ shiftlVar =
+ AST.VarDec resId
+ (AST.SubtypeIn vectorTM
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
+ [AST.ToRange (AST.PrimLit "0")
+ (AST.PrimName (AST.NAttribute $
+ AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-:
+ (AST.PrimLit "1")) ]))
+ Nothing
+ -- res := a & init(vec)
+ shiftlExpr = AST.NSimple resId AST.:=
+ (AST.PrimName (AST.NSimple aPar) AST.:&:
+ (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId initId))
+ [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
+ shiftlRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+ shiftrSpec = AST.Function (mkVHDLExtId shiftrId) [AST.IfaceVarDec vecPar vectorTM,
+ AST.IfaceVarDec aPar elemTM ] vectorTM
+ -- variable res : fsvec_x (0 to vec'length-1);
+ shiftrVar =
+ AST.VarDec resId
+ (AST.SubtypeIn vectorTM
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
+ [AST.ToRange (AST.PrimLit "0")
+ (AST.PrimName (AST.NAttribute $
+ AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-:
+ (AST.PrimLit "1")) ]))
+ Nothing
+ -- res := tail(vec) & a
+ shiftrExpr = AST.NSimple resId AST.:=
+ ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId tailId))
+ [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
+ (AST.PrimName (AST.NSimple aPar)))
+
+ shiftrRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+ nullSpec = AST.Function (mkVHDLExtId nullId) [AST.IfaceVarDec vecPar vectorTM] booleanTM
+ -- return vec'length = 0
+ nullExpr = AST.ReturnSm (Just $
+ AST.PrimName (AST.NAttribute $
+ AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:=:
+ AST.PrimLit "0")
+ rotlSpec = AST.Function (mkVHDLExtId rotlId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
+ -- variable res : fsvec_x (0 to vec'length-1);
+ rotlVar =
+ AST.VarDec resId
+ (AST.SubtypeIn vectorTM
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
+ [AST.ToRange (AST.PrimLit "0")
+ (AST.PrimName (AST.NAttribute $
+ AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-:
+ (AST.PrimLit "1")) ]))
+ Nothing
+ -- if null(vec) then res := vec else res := last(vec) & init(vec)
+ rotlExpr = AST.IfSm (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId nullId))
+ [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)])
+ [AST.NSimple resId AST.:= (AST.PrimName $ AST.NSimple vecPar)]
+ []
+ (Just $ AST.Else [rotlExprRet])
+ where rotlExprRet =
+ AST.NSimple resId AST.:=
+ ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId lastId))
+ [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
+ (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId initId))
+ [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
+ rotlRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+ rotrSpec = AST.Function (mkVHDLExtId rotrId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
+ -- variable res : fsvec_x (0 to vec'length-1);
+ rotrVar =
+ AST.VarDec resId
+ (AST.SubtypeIn vectorTM
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
+ [AST.ToRange (AST.PrimLit "0")
+ (AST.PrimName (AST.NAttribute $
+ AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-:
+ (AST.PrimLit "1")) ]))
+ Nothing
+ -- if null(vec) then res := vec else res := tail(vec) & head(vec)
+ rotrExpr = AST.IfSm (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId nullId))
+ [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)])
+ [AST.NSimple resId AST.:= (AST.PrimName $ AST.NSimple vecPar)]
+ []
+ (Just $ AST.Else [rotrExprRet])
+ where rotrExprRet =
+ AST.NSimple resId AST.:=
+ ((AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId tailId))
+ [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]) AST.:&:
+ (AST.PrimFCall $ AST.FCall (AST.NSimple (mkVHDLExtId headId))
+ [Nothing AST.:=>: AST.ADExpr (AST.PrimName $ AST.NSimple vecPar)]))
+ rotrRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+ reverseSpec = AST.Function (mkVHDLExtId reverseId) [AST.IfaceVarDec vecPar vectorTM] vectorTM
+ reverseVar =
+ AST.VarDec resId
+ (AST.SubtypeIn vectorTM
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
+ [AST.ToRange (AST.PrimLit "0")
+ (AST.PrimName (AST.NAttribute $
+ AST.AttribName (AST.NSimple vecPar) (mkVHDLBasicId lengthId) Nothing) AST.:-:
+ (AST.PrimLit "1")) ]))
+ Nothing
+ -- for i in 0 to res'range loop
+ -- res(vec'length-i-1) := vec(i);
+ -- end loop;
+ reverseFor =
+ AST.ForSM iId (AST.AttribRange $ AST.AttribName (AST.NSimple resId) rangeId Nothing) [reverseAssign]
+ -- res(vec'length-i-1) := vec(i);
+ reverseAssign = AST.NIndexed (AST.IndexedName (AST.NSimple resId) [destExp]) AST.:=
+ (AST.PrimName $ AST.NIndexed (AST.IndexedName (AST.NSimple vecPar)
+ [AST.PrimName $ AST.NSimple iId]))
+ where destExp = AST.PrimName (AST.NAttribute $ AST.AttribName (AST.NSimple vecPar)
+ (mkVHDLBasicId lengthId) Nothing) AST.:-:
+ AST.PrimName (AST.NSimple iId) AST.:-:
+ (AST.PrimLit "1")
+ -- return res;
+ reverseRet = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
+
-----------------------------------------------------------------------------
-- A table of builtin functions
-----------------------------------------------------------------------------
-- builder function.
globalNameTable :: NameTable
globalNameTable = Map.fromList
- [ (exId , (2, genFCall ) )
- , (replaceId , (3, genFCall ) )
- , (headId , (1, genFCall ) )
- , (lastId , (1, genFCall ) )
- , (tailId , (1, genFCall ) )
- , (initId , (1, genFCall ) )
- , (takeId , (2, genFCall ) )
- , (dropId , (2, genFCall ) )
- , (plusgtId , (2, genFCall ) )
+ [ (exId , (2, genFCall False ) )
+ , (replaceId , (3, genFCall False ) )
+ , (headId , (1, genFCall True ) )
+ , (lastId , (1, genFCall True ) )
+ , (tailId , (1, genFCall False ) )
+ , (initId , (1, genFCall False ) )
+ , (takeId , (2, genFCall False ) )
+ , (dropId , (2, genFCall False ) )
+ , (selId , (4, genFCall False ) )
+ , (plusgtId , (2, genFCall False ) )
+ , (ltplusId , (2, genFCall False ) )
+ , (plusplusId , (2, genFCall False ) )
, (mapId , (2, genMap ) )
, (zipWithId , (3, genZipWith ) )
, (foldlId , (3, genFoldl ) )
- --, (foldrId , (3, genFoldr ) )
- , (emptyId , (0, genFCall ) )
- , (singletonId , (1, genFCall ) )
- , (copyId , (2, genFCall ) )
+ , (foldrId , (3, genFoldr ) )
+ , (zipId , (2, genZip ) )
+ , (unzipId , (1, genUnzip ) )
+ , (shiftlId , (2, genFCall False ) )
+ , (shiftrId , (2, genFCall False ) )
+ , (rotlId , (1, genFCall False ) )
+ , (rotrId , (1, genFCall False ) )
+ , (concatId , (1, genConcat ) )
+ , (reverseId , (1, genFCall False ) )
+ , (iteratenId , (3, genIteraten ) )
+ , (iterateId , (2, genIterate ) )
+ , (generatenId , (3, genGeneraten ) )
+ , (generateId , (2, genGenerate ) )
+ , (emptyId , (0, genFCall False ) )
+ , (singletonId , (1, genFCall False ) )
+ , (copynId , (2, genFCall False ) )
+ , (copyId , (1, genCopy ) )
+ , (lengthTId , (1, genFCall False ) )
+ , (nullId , (1, genFCall False ) )
, (hwxorId , (2, genOperator2 AST.Xor ) )
, (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.Neg ) )
+ , (minusId , (2, genOperator2 (AST.:-:) ) )
+ , (fromSizedWordId , (1, genFromSizedWord ) )
+ , (fromIntegerId , (1, genFromInteger ) )
]
projects / matthijs / master-project / cλash.git / blobdiff