X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=VHDL.hs;h=b448672131c980bbe0df173fe86938235ce50ea7;hb=f330640bc6a6652d5d841ce147596e08e05e316c;hp=d2e93897811d0bbb13897b6de2d8758afd20a816;hpb=82e90697d7c570456f7bb0df8e4dc832ca242f74;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git

diff --git a/VHDL.hs b/VHDL.hs
index d2e9389..b448672 100644
--- a/VHDL.hs
+++ b/VHDL.hs
@@ -137,11 +137,26 @@ createArchitecture hsfunc fdata =
       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 mkStateProcSm (makeStatePairs 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
 
+-- | 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
 mkStateProcSm (num, old, new) =
   AST.ProcSm label [clk] [statement]
@@ -188,7 +203,9 @@ mkConcSm sigs (FApp hsfunc args res) = do
         (funcEntity fdata)
   let entity_id = ent_id entity
   label <- uniqueName (AST.fromVHDLId entity_id)
-  let portmaps = mkAssocElems sigs args res entity
+  -- Add a clk port if we have state
+  let clk_port = Maybe.fromJust $ mkAssocElem (Just $ mkVHDLId "clk") "clk"
+  let portmaps = mkAssocElems sigs args res entity ++ (if hasState hsfunc then [clk_port] else [])
   return $ AST.CSISm $ AST.CompInsSm (mkVHDLId label) (AST.IUEntity (AST.NSimple entity_id)) (AST.PMapAspect portmaps)
 
 mkConcSm sigs (UncondDef src dst) = do