diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2011-04-30 14:26:48 +0100 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2011-04-30 14:26:48 +0100 |
| commit | 224ef3094189bc9a33f23285b5dccbffdd8d7de0 (patch) | |
| tree | 551c816c8c8f7df25f060f27de82c16b00f7d2c5 /compiler/simplCore | |
| parent | fdf8656855d26105ff36bdd24d41827b05037b91 (diff) | |
| parent | d1bffa693adfa48ef65240bb3c097f5f5f77868e (diff) | |
| download | haskell-224ef3094189bc9a33f23285b5dccbffdd8d7de0.tar.gz | |
Merge remote branch 'origin/master' into ghc-new-co
Conflicts:
compiler/typecheck/TcErrors.lhs
compiler/typecheck/TcSMonad.lhs
compiler/typecheck/TcType.lhs
compiler/types/TypeRep.lhs
Diffstat (limited to 'compiler/simplCore')
| -rw-r--r-- | compiler/simplCore/CoreMonad.lhs | 14 | ||||
| -rw-r--r-- | compiler/simplCore/Simplify.lhs | 8 |
2 files changed, 15 insertions, 7 deletions
diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs index c527d820c5..6ddcff2b26 100644 --- a/compiler/simplCore/CoreMonad.lhs +++ b/compiler/simplCore/CoreMonad.lhs @@ -370,13 +370,21 @@ getCoreToDo dflags simpl_phase phase names iter = CoreDoPasses - [ maybe_strictness_before phase + $ [ maybe_strictness_before phase , CoreDoSimplify iter (base_mode { sm_phase = Phase phase , sm_names = names }) - , maybe_rule_check (Phase phase) - ] + , maybe_rule_check (Phase phase) ] + + -- Vectorisation can introduce a fair few common sub expressions involving + -- DPH primitives. For example, see the Reverse test from dph-examples. + -- We need to eliminate these common sub expressions before their definitions + -- are inlined in phase 2. The CSE introduces lots of v1 = v2 bindings, + -- so we also run simpl_gently to inline them. + ++ (if dopt Opt_Vectorise dflags && phase == 3 + then [CoreCSE, simpl_gently] + else []) vectorisation = runWhen (dopt Opt_Vectorise dflags) $ diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index 4020a765b7..3063cf4e02 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -1259,10 +1259,10 @@ completeCall env var cont | not (dopt Opt_D_dump_inlinings dflags) = stuff | not (dopt Opt_D_verbose_core2core dflags) = if isExternalName (idName var) then - pprTrace "Inlining done:" (ppr var) stuff + pprDefiniteTrace "Inlining done:" (ppr var) stuff else stuff | otherwise - = pprTrace ("Inlining done: " ++ showSDoc (ppr var)) + = pprDefiniteTrace ("Inlining done: " ++ showSDoc (ppr var)) (vcat [text "Inlined fn: " <+> nest 2 (ppr unfolding), text "Cont: " <+> ppr cont]) stuff @@ -1421,10 +1421,10 @@ tryRules env rules fn args call_cont , not (dopt Opt_D_dump_rule_rewrites dflags) = stuff | not (dopt Opt_D_dump_rule_rewrites dflags) - = pprTrace "Rule fired:" (ftext (ru_name rule)) stuff + = pprDefiniteTrace "Rule fired:" (ftext (ru_name rule)) stuff | otherwise - = pprTrace "Rule fired" + = pprDefiniteTrace "Rule fired" (vcat [text "Rule:" <+> ftext (ru_name rule), text "Before:" <+> hang (ppr fn) 2 (sep (map pprParendExpr args)), text "After: " <+> pprCoreExpr rule_rhs, |