on master help sign in
Add init, onEffects, etc. deps when registering effect managers
e99688dEvan Czaplicki
src/Optimize.hs+4−4
@@ -274,11 +274,11 @@ optimizeExpr context annExpr@(A.A region expression) =
274 Opt.Record
274 Opt.Record
275 <$> traverse (traverse justConvert) fields
275 <$> traverse (traverse justConvert) fields
276
276
277− Can.Cmd moduleName manager ->
277+ Can.Cmd home manager ->
278− Opt.Cmd moduleName <$> Env.registerEffects manager
278+ Opt.Cmd home <$> Env.registerEffects home manager
279
279
280− Can.Sub moduleName manager ->
280+ Can.Sub home manager ->
281− Opt.Sub moduleName <$> Env.registerEffects manager
281+ Opt.Sub home <$> Env.registerEffects home manager
282
282
283 Can.OutgoingPort name tipe ->
283 Can.OutgoingPort name tipe ->
284 pure (Opt.OutgoingPort name tipe)
284 pure (Opt.OutgoingPort name tipe)
src/Optimize/Environment.hs+17−6
@@ -120,12 +120,23 @@ registerHelp dep (Env vs home uid deps fx htc) =
120-- REGISTER EFFECTS
120-- REGISTER EFFECTS
121
121
122
122
123−registerEffects :: Effects.ManagerType -> Optimizer Effects.ManagerType
123+registerEffects :: ModuleName.Canonical -> Effects.ManagerType -> Optimizer Effects.ManagerType
124−registerEffects manager =
124+registerEffects home manager =
125− do State.modify (registerEffectsHelp 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)
126 return manager
128 return manager
127
129
128
130
129−registerEffectsHelp :: Effects.ManagerType -> Env -> Env
131+getEffectDeps :: ModuleName.Canonical -> Effects.ManagerType -> Set.Set Var.Global
130−registerEffectsHelp manager (Env vs home uid deps _ htc) =
132+getEffectDeps home manager =
131− Env vs home uid deps (Just manager) htc
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" ]