on master help sign in
Add init, onEffects, etc. deps when registering effect managers
commite99688d327f02147fb8c368ff7ef75f3e50e3719 authorEvan Czaplicki <evancz@users.noreply.github.com> dateTue 4 Apr 2017, 16:27 (10 years ago) parent9048477
2 files changed+21−10
src/Optimize.hs+4−4 src/Optimize/Environment.hs+17−6
src/Optimize.hs+4−4
@@ -274,11 +274,11 @@ optimizeExpr context annExpr@(A.A region expression) =
274274 Opt.Record
275275 <$> traverse (traverse justConvert) fields
276276
277− Can.Cmd moduleName manager ->
278− Opt.Cmd moduleName <$> Env.registerEffects manager
277+ Can.Cmd home manager ->
278+ Opt.Cmd home <$> Env.registerEffects home manager
279279
280− Can.Sub moduleName manager ->
281− Opt.Sub moduleName <$> Env.registerEffects manager
280+ Can.Sub home manager ->
281+ Opt.Sub home <$> Env.registerEffects home manager
282282
283283 Can.OutgoingPort name tipe ->
284284 pure (Opt.OutgoingPort name tipe)
src/Optimize/Environment.hs+17−6
@@ -120,12 +120,23 @@ registerHelp dep (Env vs home uid deps fx htc) =
120120-- REGISTER EFFECTS
121121
122122
123−registerEffects :: Effects.ManagerType -> Optimizer Effects.ManagerType
124−registerEffects manager =
125− do State.modify (registerEffectsHelp manager)
123+registerEffects :: ModuleName.Canonical -> Effects.ManagerType -> Optimizer Effects.ManagerType
124+registerEffects home manager =
125+ do (Env vs hm uid deps _ htc) <- State.get
126+ let newDeps = Set.union deps (getEffectDeps home manager)
127+ State.put (Env vs hm uid newDeps (Just manager) htc)
126128 return manager
127129
128130
129−registerEffectsHelp :: Effects.ManagerType -> Env -> Env
130−registerEffectsHelp manager (Env vs home uid deps _ htc) =
131− Env vs home uid deps (Just manager) htc
131+getEffectDeps :: ModuleName.Canonical -> Effects.ManagerType -> Set.Set Var.Global
132+getEffectDeps home manager =
133+ Set.fromList $ map (Var.Global home) $
134+ case manager of
135+ Effects.Cmds ->
136+ [ "init", "onEffects", "onSelfMsg", "cmdMap" ]
137+
138+ Effects.Subs ->
139+ [ "init", "onEffects", "onSelfMsg", "subMap" ]
140+
141+ Effects.Both ->
142+ [ "init", "onEffects", "onSelfMsg", "cmdMap", "subMap" ]