import qualified Control.Arrow as Arrow
import qualified Data.Monoid as Monoid
import Data.Accessor
+import Debug.Trace
-- ForSyDe
import qualified ForSyDe.Backend.VHDL.AST as AST
-> [AST.AssocElem] -- | The resulting port maps
mkAssocElems args res entity =
-- Create the actual AssocElems
- Maybe.catMaybes $ zipWith mkAssocElem ports sigs
+ zipWith mkAssocElem ports sigs
where
-- Turn the ports and signals from a map into a flat list. This works,
-- since the maps must have an identical form by definition. TODO: Check
arg_ports = ent_args entity
res_port = ent_res entity
-- Extract the id part from the (id, type) tuple
- ports = map (Monad.liftM fst) (res_port : arg_ports)
+ ports = map fst (res_port : arg_ports)
-- Translate signal numbers into names
sigs = (vhdlNameToVHDLExpr res : args)
-- | Create an VHDL port -> signal association
-mkAssocElem :: Maybe AST.VHDLId -> AST.Expr -> Maybe AST.AssocElem
-mkAssocElem (Just port) signal = Just $ Just port AST.:=>: (AST.ADExpr signal)
-mkAssocElem Nothing _ = Nothing
+mkAssocElem :: AST.VHDLId -> AST.Expr -> AST.AssocElem
+mkAssocElem port signal = Just port AST.:=>: (AST.ADExpr signal)
-- | Create an VHDL port -> signal association
-mkAssocElemIndexed :: Maybe AST.VHDLId -> AST.VHDLId -> AST.VHDLId -> Maybe AST.AssocElem
-mkAssocElemIndexed (Just port) signal index = Just $ Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName
+mkAssocElemIndexed :: AST.VHDLId -> AST.VHDLId -> AST.VHDLId -> AST.AssocElem
+mkAssocElemIndexed port signal index = Just port AST.:=>: (AST.ADName (AST.NIndexed (AST.IndexedName
(AST.NSimple signal) [AST.PrimName $ AST.NSimple index])))
-mkAssocElemIndexed Nothing _ _ = Nothing
mkComponentInst ::
String -- ^ The portmap label
mkComponentInst label entity_id portassigns = AST.CSISm compins
where
-- We always have a clock port, so no need to map it anywhere but here
- clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLExtId "clk") (idToVHDLExpr $ mkVHDLExtId "clk")
+ clk_port = mkAssocElem (mkVHDLExtId "clk") (idToVHDLExpr $ mkVHDLExtId "clk")
compins = AST.CompInsSm (mkVHDLExtId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect (portassigns ++ [clk_port]))
-----------------------------------------------------------------------------
-- This is a dataconstructor.
-- Not a datacon, just another signal. Perhaps we should check for
-- local/global here as well?
- Nothing -> AST.PrimName $ AST.NSimple $ varToVHDLId var
+ -- Sadly so.. tfp decimals are types, not data constructors, but instances
+ -- should still be translated to integer literals. It is probebly not the
+ -- best solution to translate them here.
+ -- FIXME: Find a better solution for translating instances of tfp integers
+ Nothing ->
+ let
+ ty = Var.varType var
+ res = case Type.splitTyConApp_maybe ty of
+ Just (tycon, args) ->
+ case Name.getOccString (TyCon.tyConName tycon) of
+ "Dec" -> AST.PrimLit $ (show (eval_tfp_int ty))
+ otherwise -> AST.PrimName $ AST.NSimple $ varToVHDLId var
+ in
+ res
-- Turn a VHDLName into an AST expression
vhdlNameToVHDLExpr = AST.PrimName
builtin_types =
Map.fromList [
("Bit", std_logicTM),
- ("Bool", booleanTM) -- TysWiredIn.boolTy
+ ("Bool", booleanTM), -- TysWiredIn.boolTy
+ ("Dec", integerTM)
]
-- Translate a Haskell type to a VHDL type, generating a new type if needed.