functiontest :: TFVec D4 Bit -> TFVec D5 Bit -> RangedWord D3 -> RangedWord D4 -> (Bit, Bit)
functiontest = \v1 v2 i1 i2 -> let r1 = v1!i1 ; r2 = v2!i2 in (r1,r2)
+xhwnot x = hwnot x
+
+maptest :: TFVec D4 Bit -> TFVec D4 Bit
+maptest = \v -> let r = map xhwnot v in r
+
highordtest2 = \a b ->
case a of
High -> \c d -> d
genMapCall ::
Int -- | The length of the vector
-> Entity -- | The entity to map
- -> AST.VHDLId -- | The input vector
- -> AST.VHDLId -- | The output vector
+ -> [AST.VHDLId] -- | The vectors
-> AST.GenerateSm -- | The resulting generate statement
-genMapCall len entity arg res = genSm
+genMapCall len entity [arg, res] = genSm
where
label = AST.unsafeVHDLBasicId "mapVector"
nPar = AST.unsafeVHDLBasicId "n"
, AST.SubProgBody tailSpec [AST.SPVD tailVar] [tailExpr, tailRet]
, AST.SubProgBody takeSpec [AST.SPVD takeVar] [takeExpr, takeRet]
, AST.SubProgBody dropSpec [AST.SPVD dropVar] [dropExpr, dropRet]
- , AST.SubProgBody plusgtSpec [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet]
+ , AST.SubProgBody plusgtSpec [AST.SPVD plusgtVar] [plusgtExpr, plusgtRet]
+ , AST.SubProgBody emptySpec [AST.SPVD emptyVar] [emptyExpr]
]
where
ixPar = AST.unsafeVHDLBasicId "ix"
((AST.PrimName $ AST.NSimple aPar) AST.:&:
(AST.PrimName $ AST.NSimple vecPar))
plusgtRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
+ emptySpec = AST.Function emptyId [] vectorTM
+ emptyVar =
+ AST.VarDec resId
+ (AST.SubtypeIn vectorTM
+ (Just $ AST.ConstraintIndex $ AST.IndexConstraint
+ [AST.ToRange (AST.PrimLit "0")
+ (AST.PrimLit "-1")]))
+ Nothing
+ emptyExpr = AST.ReturnSm (Just $ AST.PrimName (AST.NSimple resId))
\ No newline at end of file
import Constants
import Generate
-mkGlobalNameTable :: [(String, (Int, [AST.Expr] -> AST.Expr ) )] -> NameTable
+mkGlobalNameTable :: [(String, (Int, Builder) )] -> NameTable
mkGlobalNameTable = Map.fromList
globalNameTable :: NameTable
globalNameTable = mkGlobalNameTable
- [ ("!" , (2, genExprFCall exId ) )
- , ("replace" , (3, genExprFCall replaceId ) )
- , ("head" , (1, genExprFCall headId ) )
- , ("last" , (1, genExprFCall lastId ) )
- , ("tail" , (1, genExprFCall tailId ) )
- , ("init" , (1, genExprFCall initId ) )
- , ("take" , (2, genExprFCall takeId ) )
- , ("drop" , (2, genExprFCall dropId ) )
- , ("+>" , (2, genExprFCall plusgtId ) )
- , ("hwxor" , (2, genExprOp2 AST.Xor ) )
- , ("hwand" , (2, genExprOp2 AST.And ) )
- , ("hwor" , (2, genExprOp2 AST.Or ) )
- , ("hwnot" , (1, genExprOp1 AST.Not ) )
+ [ ("!" , (2, Left $ genExprFCall exId ) )
+ , ("replace" , (3, Left $ genExprFCall replaceId ) )
+ , ("head" , (1, Left $ genExprFCall headId ) )
+ , ("last" , (1, Left $ genExprFCall lastId ) )
+ , ("tail" , (1, Left $ genExprFCall tailId ) )
+ , ("init" , (1, Left $ genExprFCall initId ) )
+ , ("take" , (2, Left $ genExprFCall takeId ) )
+ , ("drop" , (2, Left $ genExprFCall dropId ) )
+ , ("+>" , (2, Left $ genExprFCall plusgtId ) )
+ , ("map" , (2, Right $ genMapCall ) )
+ , ("empty" , (0, Left $ genExprFCall emptyId ) )
+ , ("hwxor" , (2, Left $ genExprOp2 AST.Xor ) )
+ , ("hwand" , (2, Left $ genExprOp2 AST.And ) )
+ , ("hwor" , (2, Left $ genExprOp2 AST.Or ) )
+ , ("hwnot" , (1, Left $ genExprOp1 AST.Not ) )
]
-- It's a global value imported from elsewhere. These can be builtin
-- functions.
funSignatures <- getA vsNameTable
+ entSignatures <- getA vsSignatures
case (Map.lookup (bndrToString f) funSignatures) of
Just (arg_count, builder) ->
if length valargs == arg_count then
- let
- sigs = map (bndrToString.varBndr) valargs
- sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs
- func = builder sigsNames
- src_wform = AST.Wform [AST.WformElem func Nothing]
- dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr))
- assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
- in
- return [AST.CSSASm assign]
+ case builder of
+ Left funBuilder ->
+ let
+ sigs = map (bndrToString.varBndr) valargs
+ sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs
+ func = funBuilder sigsNames
+ src_wform = AST.Wform [AST.WformElem func Nothing]
+ dst_name = AST.NSimple (mkVHDLExtId (bndrToString bndr))
+ assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
+ in
+ return [AST.CSSASm assign]
+ Right genBuilder ->
+ let
+ sigs = map (varBndr) valargs
+ signature = Maybe.fromMaybe
+ (error $ "Using function '" ++ (bndrToString (head sigs)) ++ "' without signature? This should not happen!")
+ (Map.lookup (head sigs) entSignatures)
+ arg_name = mkVHDLExtId (bndrToString (last sigs))
+ dst_name = mkVHDLExtId (bndrToString bndr)
+ genSm = genBuilder 4 signature [arg_name, dst_name]
+ in return [AST.CSGSm genSm]
else
error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString valargs
Nothing -> error $ "Using function from another module that is not a known builtin: " ++ pprString f
-- A map of a Haskell function to a hardware signature
type SignatureMap = Map.Map CoreSyn.CoreBndr Entity
+type Builder = Either ([AST.Expr] -> AST.Expr) (Int -> Entity -> [AST.VHDLId] -> AST.GenerateSm)
+
-- A map of a builtin function to VHDL function builder
-type NameTable = Map.Map String (Int, [AST.Expr] -> AST.Expr )
+type NameTable = Map.Map String (Int, Builder )
data VHDLSession = VHDLSession {
-- | A map of Core type -> VHDL Type