- -- Create signal declarations for all signals that are not in args and
- -- res
- let sig_decs = Maybe.catMaybes $ map (mkSigDec . snd) sigs
- -- Create concurrent statements for all signal definitions
- statements <- mapM (mkConcSm sigs) defs
- let procs = map mkStateProcSm (getOwnStates hsfunc flatfunc)
- let procs' = map AST.CSPSm procs
- let arch = AST.ArchBody (mkVHDLId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (statements ++ procs')
- setArchitecture hsfunc arch
-
+ -- Create signal declarations for all signals that are not in args and
+ -- res
+ (ty_decls, sig_decs) = Arrow.second Maybe.catMaybes $ Traversable.traverse (mkSigDec . snd) sigs
+ -- TODO: Unique ty_decls
+ -- TODO: Store ty_decls somewhere
+ -- Create concurrent statements for all signal definitions
+ statements = zipWith (mkConcSm funcs sigs) defs [0..]
+ procs = map mkStateProcSm (makeStatePairs flatfunc)
+ procs' = map AST.CSPSm procs
+ in
+ Just $ AST.ArchBody (mkVHDLId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (statements ++ procs')
+
+-- | Looks up all pairs of old state, new state signals, together with
+-- the state id they represent.
+makeStatePairs :: FlatFunction -> [(StateId, SignalInfo, SignalInfo)]
+makeStatePairs flatfunc =
+ [(Maybe.fromJust $ oldStateId $ sigUse old_info, old_info, new_info)
+ | old_info <- map snd (flat_sigs flatfunc)
+ , new_info <- map snd (flat_sigs flatfunc)
+ -- old_info must be an old state (and, because of the next equality,
+ -- new_info must be a new state).
+ , Maybe.isJust $ oldStateId $ sigUse old_info
+ -- And the state numbers must match
+ , (oldStateId $ sigUse old_info) == (newStateId $ sigUse new_info)]
+
+ -- Replace the second tuple element with the corresponding SignalInfo
+ --args_states = map (Arrow.second $ signalInfo sigs) args