- -- Create signal declarations for all signals that are not in args and
- -- res
- let sig_decs = [mkSigDec info | (id, info) <- sigs, (all (id `Foldable.notElem`) (res:args)) ]
- -- Create component instantiations for all function applications
- insts <- mapM (mkCompInsSm sigs) apps
- let procs = map mkStateProcSm (getOwnStates hsfunc flatfunc)
- let insts' = map AST.CSISm insts
- let procs' = map AST.CSPSm procs
- let arch = AST.ArchBody (mkVHDLId "structural") (AST.NSimple entity_id) (map AST.BDISD sig_decs) (insts' ++ procs')
- setArchitecture hsfunc arch
-
-mkStateProcSm :: (Int, SignalInfo, SignalInfo) -> AST.ProcSm
+ -- 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
+mkStateProcSm :: (StateId, SignalInfo, SignalInfo) -> AST.ProcSm