import qualified ForSyDe.Backend.VHDL.AST as AST
import Constants
+-- | Generate a binary operator application. The first argument should be a
+-- constructor from the AST.Expr type, e.g. AST.And.
+genExprOp2 :: (AST.Expr -> AST.Expr -> AST.Expr) -> [AST.Expr] -> AST.Expr
+genExprOp2 op [arg1, arg2] = op arg1 arg2
+
+-- | Generate a unary operator application
+genExprOp1 :: (AST.Expr -> AST.Expr) -> [AST.Expr] -> AST.Expr
+genExprOp1 op [arg] = op arg
+
-- | Generate a function call from the Function Name and a list of expressions
-- (its arguments)
genExprFCall :: AST.VHDLId -> [AST.Expr] -> AST.Expr
AST.PrimFCall $ AST.FCall (AST.NSimple fName) $
map (\exp -> Nothing AST.:=>: AST.ADExpr exp) args
--- | List version of genExprFCall1
-genExprFCall1L :: AST.VHDLId -> [AST.Expr] -> AST.Expr
-genExprFCall1L fName [arg] = genExprFCall fName [arg]
-genExprFCall1L _ _ = error "Generate.genExprFCall1L incorrect length"
-
--- | List version of genExprFCall2
-genExprFCall2L :: AST.VHDLId -> [AST.Expr] -> AST.Expr
-genExprFCall2L fName [arg1, arg2] = genExprFCall fName [arg1,arg2]
-genExprFCall2L _ _ = error "Generate.genExprFCall2L incorrect length"
-
genUnconsVectorFuns :: AST.TypeMark -- ^ type of the vector elements
-> AST.TypeMark -- ^ type of the vector
-> [AST.SubProgBody]
(AST.PrimName (AST.NAttribute $
AST.AttribName (AST.NSimple vecPar) lengthId Nothing)
AST.:-: AST.PrimLit "1"))
- dropRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
\ No newline at end of file
+ dropRet = AST.ReturnSm (Just $ AST.PrimName $ AST.NSimple resId)
globalNameTable :: NameTable
globalNameTable = mkGlobalNameTable
- [ ("!" , (2, genExprFCall2L exId ) )
- , ("head" , (1, genExprFCall1L headId ) )
- ]
\ No newline at end of file
+ [ ("!" , (2, genExprFCall exId ) )
+ , ("head" , (1, genExprFCall headId ) )
+ , ("hwxor" , (2, genExprOp2 AST.Xor ) )
+ , ("hwand" , (2, genExprOp2 AST.And ) )
+ , ("hwor" , (2, genExprOp2 AST.And ) )
+ , ("hwnot" , (1, genExprOp1 AST.Not ) )
+ ]
let sel_name = mkSelectedName bndr label in
mkUncondAssign (Right sel_name) (varToVHDLExpr arg)
IdInfo.VanillaGlobal -> do
- -- It's a global value imported from elsewhere. These can be builting
+ -- It's a global value imported from elsewhere. These can be builtin
-- functions.
funSignatures <- getA vsNameTable
case (Map.lookup (bndrToString f) funSignatures) of
- Just funSignature ->
- let
- sigs = map (bndrToString.varBndr) args
- sigsNames = map (\signal -> (AST.PrimName (AST.NSimple (mkVHDLExtId signal)))) sigs
- func = (snd funSignature) 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
+ Just (arg_count, builder) ->
+ if length args == arg_count then
+ let
+ sigs = map (bndrToString.varBndr) args
+ 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
+ else
+ error $ "VHDL.mkConcSm Incorrect number of arguments to builtin function: " ++ pprString f ++ " Args: " ++ pprString args
Nothing -> error $ "Using function from another module that is not a known builtin: " ++ pprString f
IdInfo.NotGlobalId -> do
signatures <- getA vsSignatures