Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Enforce that context identifiers do not leak between iterations

  • Loading branch information...
commit 07aeb531d3ad6ef8ca7255265acd7a229678f3dc 1 parent 5dcd62d
Max Bolingbroke authored July 08, 2010
35  Supercompile/Split.hs
@@ -221,6 +221,14 @@ optimiseSplit optimise_bracketed floats_h floats_compulsory = do
221 221
     (fvs', xes') <- residualise [] S.empty fvs_compulsory'
222 222
     return (fvs', letRec xes' e_compulsory')
223 223
 
  224
+-- Whether the given variable was entered many times, with no context identifier information required
  225
+-- I'm using this abstraction to make explicit the fact that we don't pass context identifiers between
  226
+-- iterations of the splitter "go" loop. This is important because they are potentially unstable!
  227
+type EnteredManyEnv = M.Map (Out Var) Bool
  228
+
  229
+toEnteredManyEnv :: EnteredEnv -> EnteredManyEnv
  230
+toEnteredManyEnv = M.map (not . isOnce)
  231
+
224 232
 split'
225 233
   :: Monad m
226 234
   => (State -> m (FreeVars, Out Term))
@@ -231,11 +239,11 @@ split'
231 239
       M.Map (Out Var) (Bracketed PureState),
232 240
       Bracketed PureState)
233 241
 split' opt (cheapifyHeap -> Heap h (splitIdSupply -> (ids1, ids2))) k (entered_hole, bracketed_hole)
234  
-  = go S.empty entered_hole
  242
+  = go S.empty (toEnteredManyEnv entered_hole)
235 243
   where
236  
-    go must_resid_k_xs entered
  244
+    go must_resid_k_xs entered_many
237 245
       -- | traceRender ("split.go", entered, entered_k, xs_nonvalue_inlinings) False = undefined
238  
-      | entered == entered' -- FIXME: very very suspicious, because the Once ids may change
  246
+      | entered_many == entered_many'
239 247
       , must_resid_k_xs == must_resid_k_xs'
240 248
       = -- (\res -> traceRender ("split'", entered_hole, "==>", entered_k, "==>", entered', must_resid_k_xs, [x' | Tagged _ (Update x') <- k], M.keysSet floats_k_bound) res) $
241 249
         (\brack -> do
@@ -245,7 +253,7 @@ split' opt (cheapifyHeap -> Heap h (splitIdSupply -> (ids1, ids2))) k (entered_h
245 253
           return (fvs', e'),
246 254
          M.map promoteToBracket (h `exclude` xs_nonvalue_inlinings) `M.union` floats_k_bound,
247 255
          bracket_k)
248  
-      | otherwise = go must_resid_k_xs' entered'
  256
+      | otherwise = go must_resid_k_xs' entered_many'
249 257
       where
250 258
         -- Evaluation context splitting
251 259
         -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -261,12 +269,15 @@ split' opt (cheapifyHeap -> Heap h (splitIdSupply -> (ids1, ids2))) k (entered_h
261 269
         -- ~~~~~~~~~~~~~~
262 270
         
263 271
         -- Guess which parts of the heap are safe for inlining based on the current Entered information
264  
-        (h_inlineable, entered', must_resid_k_xs') = splitPureHeap h entered entered_k
  272
+        (h_inlineable, entered', must_resid_k_xs') = splitPureHeap h entered_many entered_k
  273
+        
265 274
         -- NB: We must NOT take non-values that we have decided to inline and then bind them in the residual term. This does not
266 275
         -- usually happen because such things won't be free variables of the immediate output term, but with strict bindings the
267 276
         -- optimiser will be forced to residualise such bindings anyway. Explicitly filter them out to be sure we don't spuriously
268 277
         -- recompute such bindings, BUT make sure to retain non-value bindings that are used Once by the *residual itself*:
269 278
         xs_nonvalue_inlinings = M.keysSet $ M.filterWithKey (\x (_, e) -> maybe False (/= Once Nothing) (M.lookup x entered') && not (taggedTermIsCheap e)) h_inlineable
  279
+        
  280
+        entered_many' = toEnteredManyEnv entered'
270 281
 
271 282
     promoteToPureState :: In TaggedTerm -> PureState
272 283
     promoteToPureState in_e = (M.empty, [], in_e)
@@ -274,9 +285,9 @@ split' opt (cheapifyHeap -> Heap h (splitIdSupply -> (ids1, ids2))) k (entered_h
274 285
     promoteToBracket :: In TaggedTerm -> Bracketed PureState
275 286
     promoteToBracket in_e = Bracketed (\[e'] -> e') S.empty (\[fvs'] -> fvs') [promoteToPureState in_e]
276 287
 
277  
-splitPureHeap :: PureHeap -> EnteredEnv -> EnteredEnv -> (PureHeap, EnteredEnv, FreeVars)
278  
-splitPureHeap h entered entered_k = -- traceRender ("splitPureHeap", (residualisePureHeap prettyIdSupply h), (entered, entered_k), "=>", entered', must_resid_k_xs') $
279  
-                                    (h_inlineable, entered', must_resid_k_xs')
  288
+splitPureHeap :: PureHeap -> M.Map Var Bool -> EnteredEnv -> (PureHeap, EnteredEnv, FreeVars)
  289
+splitPureHeap h was_entered_many entered_k = -- traceRender ("splitPureHeap", (residualisePureHeap prettyIdSupply h), (entered, entered_k), "=>", entered', must_resid_k_xs') $
  290
+                                             (h_inlineable, entered', must_resid_k_xs')
280 291
   where
281 292
     -- Linearity
282 293
     -- ~~~~~~~~~
@@ -284,10 +295,10 @@ splitPureHeap h entered entered_k = -- traceRender ("splitPureHeap", (residualis
284 295
     -- We have already gathered entry information from the Stack. Carry on, gathering
285 296
     -- it from the Heap as well. Assume Heap bindings are used as many times as they were used
286 297
     -- the last time we went around the loop.
287  
-    entered' = M.foldWithKey (\x' in_e entered' -> entered' `plusEnteredEnv` incorporate (fromJust $ name_id x') (M.lookup x' entered) in_e) entered_k h
288  
-    incorporate _ Nothing    _    = emptyEnteredEnv
289  
-    incorporate i (Just ent) in_e = -- (\res -> traceRender ("incorporate", mb_id, ent, inFreeVars taggedTermFreeVars in_e) res) $
290  
-                                    mkEnteredEnv (if taggedTermIsCheap (snd in_e) && not (isOnce ent) then Many else Once (Just i)) (inFreeVars taggedTermFreeVars in_e)
  298
+    entered' = M.foldWithKey (\x' in_e entered' -> entered' `plusEnteredEnv` incorporate (fromJust $ name_id x') (M.lookup x' was_entered_many) in_e) entered_k h
  299
+    incorporate _ Nothing         _    = emptyEnteredEnv
  300
+    incorporate i (Just was_many) in_e = -- (\res -> traceRender ("incorporate", mb_id, ent, inFreeVars taggedTermFreeVars in_e) res) $
  301
+                                         mkEnteredEnv (if taggedTermIsCheap (snd in_e) && was_many then Many else Once (Just i)) (inFreeVars taggedTermFreeVars in_e)
291 302
      -- Cheap things may be duplicated, so if they are used Many times so will their FVs be. Non-cheap things are either:
292 303
      --   a) Residualised immediately and so they enter their FVs at most Once
293 304
      --   b) Duplicated downwards, but used linearly anyway, so their FVs are still used Once
5  Termination/Terminate.hs
@@ -40,6 +40,10 @@ emptyHistory = []
40 40
 
41 41
 data TermRes = Stop | Continue History
42 42
 
  43
+isStop :: TermRes -> Bool
  44
+isStop Stop = True
  45
+isStop _    = False
  46
+
43 47
 terminate :: History -> TagBag -> TermRes
44 48
 terminate hist here
45 49
   -- | traceRender (length hist, tagBag here) && False = undefined
@@ -47,3 +51,4 @@ terminate hist here
47 51
   = Stop
48 52
   | otherwise
49 53
   = Continue (here : hist)
  54
+

0 notes on commit 07aeb53

Please sign in to comment.
Something went wrong with that request. Please try again.