[commit: ghc] supercompiler: Tweak computation of MSG stack generalisation flag (fab4a36)
Max Bolingbroke <[email protected]>
| Newsgroups | gmane.comp.lang.haskell.cvs.ghc |
|---|---|
| Message-ID | <[email protected]> |
Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : supercompiler http://hackage.haskell.org/trac/ghc/changeset/fab4a36aa3d04cb3ae624951b62fea21530434ad >--------------------------------------------------------------- commit fab4a36aa3d04cb3ae624951b62fea21530434ad Author: Max Bolingbroke <[email protected]> Date: Wed Apr 18 18:54:12 2012 +0100 Tweak computation of MSG stack generalisation flag >--------------------------------------------------------------- compiler/supercompile/Supercompile/Drive/MSG.hs | 2 +- 1 files changed, 1 insertions(+), 1 deletions(-) diff --git a/compiler/supercompile/Supercompile/Drive/MSG.hs b/compiler/supercompile/Supercompile/Drive/MSG.hs index b8bbe2a..0458f6d 100644 --- a/compiler/supercompile/Supercompile/Drive/MSG.hs +++ b/compiler/supercompile/Supercompile/Drive/MSG.hs @@ -435,7 +435,7 @@ msgEC init_rn2 = go init_rn2 (kf_r, k_r) <- splitCar "right" k_r (rn2'', mkf') <- msgECFrame rn2' kf_l kf_r return (map (liftM (second (\it rn2 -> liftM2 (\kf (k_l, k, k_r) -> (k_l, kf `Car` k, k_r)) (mkf' rn2) (it rn2)))) $ go rn2'' k_l k_r)) ++ - [return (rn2', \_ -> return (k_l, Loco (not (nullTrain k_r)), k_r))] -- Right biased generalisation flag + [return (rn2', \_ -> return (k_l, Loco (case k_r of Loco gen -> gen; _ -> True), k_r))] -- Right biased generalisation flag msgECFrame :: RnEnv2 -> Tagged StackFrame -> Tagged StackFrame -> MSG' (RnEnv2, RnEnv2 -> MSG (Tagged StackFrame)) msgECFrame init_rn2 kf_l kf_r = liftM (second (liftM (Tagged (tag kf_r)) .)) $ go (tagee kf_l) (tagee kf_r) -- Right biased