X-Git-Url: https://git.stderr.nl/gitweb?a=blobdiff_plain;f=Translator.hs;h=383c477282e04fa3429c153520cf13064eca1d0d;hb=0de275199ba2f3a98339eefb7784e061a451c5f7;hp=2373c342dd40a0f861d014901d19ff71c50b3785;hpb=d5cfe79d359fd4d7177a6cc7232ccb294ce039f8;p=matthijs%2Fmaster-project%2Fc%CE%BBash.git diff --git a/Translator.hs b/Translator.hs index 2373c34..383c477 100644 --- a/Translator.hs +++ b/Translator.hs @@ -190,7 +190,6 @@ propagateState :: propagateState hsfunc flatfunc = flatfunc {flat_defs = apps', flat_sigs = sigs'} where - apps = filter is_FApp (flat_defs flatfunc) (olds, news) = unzip $ getStateSignals hsfunc flatfunc states' = zip olds news -- Find all signals used by all sigdefs @@ -201,7 +200,7 @@ propagateState hsfunc flatfunc = -- Find the states whose "old state" signal is used only once single_use_states = filter ((`notElem` multiple_uses) . fst) states' -- See if these single use states can be propagated - (substate_sigss, apps') = unzip $ map (propagateState' single_use_states) apps + (substate_sigss, apps') = unzip $ map (propagateState' single_use_states) (flat_defs flatfunc) substate_sigs = concat substate_sigss -- Mark any propagated state signals as SigSubState sigs' = map @@ -212,18 +211,20 @@ propagateState hsfunc flatfunc = propagateState' :: [(SignalId, SignalId)] -- ^ TODO - -> SigDef -- ^ The function application to process. Must be - -- a FApp constructor. + -> SigDef -- ^ The SigDef to process. -> ([SignalId], SigDef) -- ^ Any signal ids that should become substates, -- and the resulting application. -propagateState' states app = - (our_old ++ our_new, app {appFunc = hsfunc'}) +propagateState' states def = + if (is_FApp def) then + (our_old ++ our_new, def {appFunc = hsfunc'}) + else + ([], def) where - hsfunc = appFunc app - args = appArgs app - res = appRes app + hsfunc = appFunc def + args = appArgs def + res = appRes def our_states = filter our_state states -- A state signal belongs in this function if the old state is -- passed in, and the new state returned @@ -386,7 +387,7 @@ addBuiltIn (BuiltIn name args res) = do setEntity hsfunc entity where hsfunc = HsFunction name (map useAsPort args) (useAsPort res) - entity = Entity (VHDL.mkVHDLId name) (map toVHDLSignalMap args) (toVHDLSignalMap res) Nothing + entity = Entity (VHDL.mkVHDLId name) (map toVHDLSignalMap args) (toVHDLSignalMap res) Nothing Nothing builtin_funcs = [