hwfunc <- mkHWFunction bind hsfunc
-- Add it to the session
addFunc hsfunc hwfunc
- arch <- getArchitecture hwfunc expr
- let entity = getEntity hwfunc
+ arch <- getArchitecture hsfunc hwfunc expr
+ -- Give every entity a clock port
+ -- TODO: Omit this for stateless entities
+ let clk_port = AST.IfaceSigDec (mkVHDLId "clk") AST.In vhdl_bit_ty
+ let entity = getEntity hwfunc [clk_port]
return $ [
AST.LUEntity entity,
AST.LUArch arch ]
getArchitecture ::
- HWFunction -- The function to generate an architecture for
+ HsFunction -- The function interface
+ -> HWFunction -- The function to generate an architecture for
-> CoreExpr -- The expression that is bound to the function
-> VHDLState AST.ArchBody -- The resulting architecture
-getArchitecture hwfunc expr = do
+getArchitecture hsfunc hwfunc expr = do
-- Unpack our hwfunc
let HWFunction vhdl_id inports outport = hwfunc
-- Expand the expression into an architecture body
(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
+ let (inport_assigns, instate_map) = concat_elements $ unzip $ zipWith3 createSignalAssignments arg_signals inports (hsArgs hsfunc)
+ let (outport_assigns, outstate_map) = createSignalAssignments outport res_signal (hsRes hsfunc)
+ let state_procs = map AST.CSPSm $ createStateProcs (sortMap instate_map) (sortMap outstate_map)
return $ AST.ArchBody
(AST.unsafeVHDLBasicId "structural")
(AST.NSimple vhdl_id)
(map AST.BDISD signal_decls)
- (inport_assigns ++ outport_assigns ++ statements)
+ (state_procs ++ inport_assigns ++ outport_assigns ++ statements)
+
+-- | Sorts a map modeled as a list of (key,value) pairs by key
+sortMap :: Ord a => [(a, b)] -> [(a, b)]
+sortMap = List.sortBy (\(a, _) (b, _) -> compare a b)
+
+-- | Generate procs for state variables
+createStateProcs ::
+ [(Int, AST.VHDLId)]
+ -- ^ The sorted list of signals that should be assigned
+ -- to each state
+ -> [(Int, AST.VHDLId)]
+ -- ^ The sorted list of signals that contain each new state
+ -> [AST.ProcSm] -- ^ The resulting procs
+
+createStateProcs ((old_num, old_id):olds) ((new_num, new_id):news) =
+ if (old_num == new_num)
+ then
+ AST.ProcSm label [clk] [statement] : createStateProcs olds news
+ else
+ error "State numbers don't match!"
+ where
+ label = mkVHDLId $ "state_" ++ (show old_num)
+ clk = mkVHDLId "clk"
+ rising_edge = AST.NSimple $ mkVHDLId "rising_edge"
+ wform = AST.Wform [AST.WformElem (AST.PrimName $ AST.NSimple $ new_id) Nothing]
+ assign = AST.SigAssign (AST.NSimple old_id) wform
+ rising_edge_clk = AST.PrimFCall $ AST.FCall rising_edge [Nothing AST.:=>: (AST.ADName $ AST.NSimple clk)]
+ statement = AST.IfSm rising_edge_clk [assign] [] Nothing
+
+createStateProcs [] [] = []
-- Generate a VHDL entity declaration for the given function
-getEntity :: HWFunction -> AST.EntityDec
-getEntity (HWFunction vhdl_id inports outport) =
+getEntity :: HWFunction -> [AST.IfaceSigDec] -> AST.EntityDec
+getEntity (HWFunction vhdl_id inports outport) extra_ports =
AST.EntityDec vhdl_id ports
where
ports =
(concat $ map (mkIfaceSigDecs AST.In) inports)
++ mkIfaceSigDecs AST.Out outport
+ ++ extra_ports
mkIfaceSigDecs ::
AST.Mode -- The port's mode (In or Out)
-- Create concurrent assignments of one map of signals to another. The maps
-- should have a similar form.
createSignalAssignments ::
- SignalNameMap -- The signals to assign to
- -> SignalNameMap -- The signals to assign
- -> [AST.ConcSm] -- The resulting assignments
+ SignalNameMap -- The signals to assign to
+ -> SignalNameMap -- The signals to assign
+ -> HsUseMap -- What function does each of the signals have?
+ -> ([AST.ConcSm], -- The resulting assignments
+ [(Int, AST.VHDLId)]) -- The resulting state -> signal mappings
-- A simple assignment of one signal to another (greatly complicated because
-- signal assignments can be conditional with multiple conditions in VHDL).
-createSignalAssignments (Single (dst, _)) (Single (src, _)) =
- [AST.CSSASm assign]
+createSignalAssignments (Single (dst, _)) (Single (src, _)) (Single Port)=
+ ([AST.CSSASm assign], [])
where
src_name = AST.NSimple src
src_expr = AST.PrimName src_name
dst_name = (AST.NSimple dst)
assign = dst_name AST.:<==: (AST.ConWforms [] src_wform Nothing)
-createSignalAssignments (Tuple dsts) (Tuple srcs) =
- concat $ zipWith createSignalAssignments dsts srcs
+createSignalAssignments (Tuple dsts) (Tuple srcs) (Tuple uses) =
+ concat_elements $ unzip $ zipWith3 createSignalAssignments dsts srcs uses
-createSignalAssignments Unused (Single (src, _)) =
+createSignalAssignments Unused (Single (src, _)) (Single (State n)) =
-- Write state
- []
+ ([], [(n, src)])
-createSignalAssignments (Single (src, _)) Unused =
+createSignalAssignments (Single (dst, _)) Unused (Single (State n)) =
-- Read state
- []
+ ([], [(n, dst)])
-createSignalAssignments dst src =
- error $ "Non matching source and destination: " ++ show dst ++ " <= " ++ show src
+createSignalAssignments dst src use =
+ error $ "Non matching source and destination: " ++ show dst ++ " <= " ++ show src ++ " (Used as " ++ show use ++ ")"
type SignalNameMap = HsValueMap (AST.VHDLId, AST.TypeMark)
mkVHDLId :: String -> AST.VHDLId
mkVHDLId = AST.unsafeVHDLBasicId
+-- Concatenate each of the lists of lists inside the given tuple.
+-- Since the element types in the lists might differ, we can't generalize
+-- this (unless we pass in f twice).
+concat_elements :: ([[a]], [[b]]) -> ([a], [b])
+concat_elements (a, b) = (concat a, concat b)
+
builtin_funcs =
[
(HsFunction "hwxor" [(Single Port), (Single Port)] (Single Port), HWFunction (mkVHDLId "hwxor") [Single (mkVHDLId "a", vhdl_bit_ty), Single (mkVHDLId "b", vhdl_bit_ty)] (Single (mkVHDLId "o", vhdl_bit_ty))),
projects / matthijs / master-project / cλash.git / blobdiff