--core <- GHC.compileToCoreSimplified "Adders.hs"
core <- GHC.compileToCoreSimplified "Adders.hs"
liftIO $ printBinds (cm_binds core)
- let bind = findBind "half_adder" (cm_binds core)
+ let bind = findBind "inv" (cm_binds core)
let NonRec var expr = bind
-- Turn bind into VHDL
let vhdl = State.evalState (mkVHDL bind) (VHDLSession 0 builtin_funcs)
)
getPortMapEntry ::
- PortNameMap -- The port name to bind to
+ SignalNameMap AST.VHDLId -- The port name to bind to
-> AST.VHDLName -- The signal or port to bind to it
-> AST.AssocElem -- The resulting port map entry
-- Accepts a port name and an argument to map to it.
-- Returns the appropriate line for in the port map
-getPortMapEntry (Port portname) signame =
- (Just (AST.unsafeVHDLBasicId portname)) AST.:=>: (AST.ADName signame)
+getPortMapEntry (Signal portname) signame =
+ (Just portname) AST.:=>: (AST.ADName signame)
getInstantiations ::
- [PortNameMap] -- The arguments that need to be applied to the
+ [SignalNameMap AST.VHDLId] -- The arguments that need to be applied to the
-- expression.
- -> PortNameMap -- The output ports that the expression should generate.
- -> [(CoreBndr, PortNameMap)] -- A list of bindings in effect
+ -> SignalNameMap AST.VHDLId -- The output ports that the expression should generate.
+ -> [(CoreBndr, SignalNameMap AST.VHDLId)]
+ -- A list of bindings in effect
-> CoreSyn.CoreExpr -- The expression to generate an architecture for
- -> VHDLState ([AST.SigDec], [AST.ConcSm]) -- The resulting VHDL code
+ -> VHDLState ([AST.SigDec], [AST.ConcSm])
+ -- The resulting VHDL code
-- A lambda expression binds the first argument (a) to the binder b.
getInstantiations (a:as) outs binds (Lam b expr) =
getInstantiations args outs binds expr =
error $ "Unsupported expression" ++ (showSDoc $ ppr $ expr)
+expandExpr ::
+ [(CoreBndr, SignalNameMap AST.VHDLName)]
+ -- A list of bindings in effect
+ -> CoreExpr -- The expression to expand
+ -> VHDLState (
+ [AST.SigDec], -- Needed signal declarations
+ [AST.ConcSm], -- Needed component instantations and
+ -- signal assignments.
+ [SignalNameMap AST.VHDLId], -- The signal names corresponding to
+ -- the expression's arguments
+ SignalNameMap AST.VHDLId) -- The signal names corresponding to
+ -- the expression's result.
+expandExpr binds (Lam b expr) = do
+ -- Generate a new signal to which we will expect this argument to be bound.
+ signal_name <- uniqueName ("arg-" ++ getOccString b)
+ let (signal_id, signal_decl) = mkSignal signal_name vhdl_bit_ty
+ -- Add the binder to the list of binds
+ let binds' = (b, Signal (AST.NSimple signal_id)) : binds
+ -- Expand the rest of the expression
+ (signal_decls, statements, arg_signals, res_signal) <- expandExpr binds' expr
+ -- Properly merge the results
+ return (signal_decl : signal_decls,
+ statements,
+ (Signal signal_id) : arg_signals,
+ res_signal)
+
+expandExpr binds (Var id) =
+ return ([], [], [], Signal signal_id)
+ where
+ -- Lookup the id in our binds map
+ Signal (AST.NSimple signal_id) = Maybe.fromMaybe
+ (error $ "Argument " ++ getOccString id ++ "is unknown")
+ (lookup id binds)
+
+expandExpr binds expr =
+ error $ "Unsupported expression: " ++ (showSDoc $ ppr $ expr)
+
+-- Generate a signal declaration for a signal with the given name and the
+-- given type and no value. Also returns the id of the signal.
+mkSignal :: String -> AST.TypeMark -> (AST.VHDLId, AST.SigDec)
+mkSignal name ty =
+ (id, AST.SigDec id ty Nothing)
+ where
+ id = AST.unsafeVHDLBasicId name
+
expandArgs ::
- [(CoreBndr, PortNameMap)] -- A list of bindings in effect
+ [(CoreBndr, SignalNameMap AST.VHDLId)] -- A list of bindings in effect
-> [CoreExpr] -- The arguments to expand
-> VHDLState ([AST.SigDec], [AST.ConcSm], [AST.VHDLName])
-- The resulting signal declarations,
-- A simple variable reference should be in our binds map
Var id -> return $ let
-- Lookup the id in our binds map
- Port signalname = Maybe.fromMaybe
+ Signal signalid = Maybe.fromMaybe
(error $ "Argument " ++ getOccString id ++ "is unknown")
(lookup id binds)
in
-- Create a VHDL name from the signal name
- AST.NSimple (AST.unsafeVHDLBasicId signalname)
+ AST.NSimple signalid
-- Other expressions are unsupported
otherwise -> error ("Unsupported expression used as argument: " ++ (showSDoc $ ppr e))
-- Expand the rest
(tys, vals) = splitTupleConstructorArgs es
mapOutputPorts ::
- PortNameMap -- The output portnames of the component
- -> PortNameMap -- The output portnames and/or signals to map these to
- -> [AST.AssocElem] -- The resulting output ports
+ SignalNameMap AST.VHDLId -- The output portnames of the component
+ -> SignalNameMap AST.VHDLId -- The output portnames and/or signals to map these to
+ -> [AST.AssocElem] -- The resulting output ports
-- Map the output port of a component to the output port of the containing
-- entity.
-mapOutputPorts (Port portname) (Port signalname) =
- [(Just (AST.unsafeVHDLBasicId portname)) AST.:=>: (AST.ADName (AST.NSimple (AST.unsafeVHDLBasicId signalname)))]
+mapOutputPorts (Signal portname) (Signal signalname) =
+ [(Just portname) AST.:=>: (AST.ADName (AST.NSimple signalname))]
-- Map matching output ports in the tuple
mapOutputPorts (Tuple ports) (Tuple signals) =
let name = (getOccString var)
HWFunction inports outport <- getHWFunc name
sess <- State.get
- (sigs, comps) <- getInstantiations inports outport [] expr
+ (signal_decls, statements, arg_signals, res_signal) <- expandExpr [] expr
+ let inport_assigns = concat $ zipWith createSignalAssignments arg_signals inports
+ let outport_assigns = createSignalAssignments outport res_signal
return $ AST.ArchBody
(AST.unsafeVHDLBasicId "structural")
-- Use unsafe for now, to prevent pulling in ForSyDe error handling
(AST.NSimple (AST.unsafeVHDLBasicId name))
- (map AST.BDISD sigs)
- comps
-
-data PortNameMap =
- Tuple [PortNameMap]
- | Port String
+ (map AST.BDISD signal_decls)
+ (inport_assigns ++ outport_assigns ++ statements)
+
+-- Create concurrent assignments of one map of signals to another. The maps
+-- should have a similar form.
+createSignalAssignments ::
+ SignalNameMap AST.VHDLId -- The signals to assign to
+ -> SignalNameMap AST.VHDLId -- The signals to assign
+ -> [AST.ConcSm] -- The resulting assignments
+
+-- A simple assignment of one signal to another (greatly complicated because
+-- signal assignments can be conditional with multiple conditions in VHDL).
+createSignalAssignments (Signal dst) (Signal src) =
+ [AST.CSSASm assign]
+ where
+ src_name = AST.NSimple src
+ src_expr = AST.PrimName src_name
+ src_wform = AST.Wform [AST.WformElem src_expr Nothing]
+ dst_name = (AST.NSimple dst)
+ assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
+
+createSignalAssignments (Tuple dsts) (Tuple srcs) =
+ concat $ zipWith createSignalAssignments dsts srcs
+
+data SignalNameMap t =
+ Tuple [SignalNameMap t]
+ | Signal t
deriving (Show)
-- Generate a port name map (or multiple for tuple types) in the given direction for
-- each type given.
-getPortNameMapForTys :: String -> Int -> [Type] -> [PortNameMap]
+getPortNameMapForTys :: String -> Int -> [Type] -> [SignalNameMap AST.VHDLId]
getPortNameMapForTys prefix num [] = []
getPortNameMapForTys prefix num (t:ts) =
(getPortNameMapForTy (prefix ++ show num) t) : getPortNameMapForTys prefix (num + 1) ts
-getPortNameMapForTy :: String -> Type -> PortNameMap
+getPortNameMapForTy :: String -> Type -> SignalNameMap AST.VHDLId
getPortNameMapForTy name ty =
if (TyCon.isTupleTyCon tycon) then
-- Expand tuples we find
Tuple (getPortNameMapForTys name 0 args)
else -- Assume it's a type constructor application, ie simple data type
-- TODO: Add type?
- Port name
+ Signal (AST.unsafeVHDLBasicId name)
where
(tycon, args) = Type.splitTyConApp ty
data HWFunction = HWFunction { -- A function that is available in hardware
- inPorts :: [PortNameMap],
- outPort :: PortNameMap
+ inPorts :: [SignalNameMap AST.VHDLId],
+ outPort :: SignalNameMap AST.VHDLId
--entity :: AST.EntityDec
} deriving (Show)
count <- State.gets nameCount -- Get the funcs element from the session
State.modify (\s -> s {nameCount = count + 1})
return $ name ++ "-" ++ (show count)
-
+
+-- Shortcut
+mkVHDLId :: String -> AST.VHDLId
+mkVHDLId = AST.unsafeVHDLBasicId
+
builtin_funcs =
[
- ("hwxor", HWFunction [Port "a", Port "b"] (Port "o")),
- ("hwand", HWFunction [Port "a", Port "b"] (Port "o"))
+ ("hwxor", HWFunction [Signal $ mkVHDLId "a", Signal $ mkVHDLId "b"] (Signal $ mkVHDLId "o")),
+ ("hwand", HWFunction [Signal $ mkVHDLId "a", Signal $ mkVHDLId "b"] (Signal $ mkVHDLId "o"))
]
+vhdl_bit_ty :: AST.TypeMark
+vhdl_bit_ty = AST.unsafeVHDLBasicId "Bit"
+
-- vim: set ts=8 sw=2 sts=2 expandtab:
projects / matthijs / master-project / cλash.git / blobdiff