[commit: ghc] master: Add flag to control loopification (7a4c15a)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/7a4c15a0ee045ac5d2b48865997c7f5e8697afa3/ghc

>---------------------------------------------------------------

commit 7a4c15a0ee045ac5d2b48865997c7f5e8697afa3
Author: Jan Stolarek <jan.stolarek at p.lodz.pl>
Date:   Wed Sep 18 09:25:56 2013 +0100

    Add flag to control loopification
    
    It is off by default, which is meant to be a workaround for #8275.
    Once #8275 is fixed we will enable this option by default.


>---------------------------------------------------------------

7a4c15a0ee045ac5d2b48865997c7f5e8697afa3
 compiler/codeGen/StgCmmClosure.hs |    5 +++--
 compiler/codeGen/StgCmmExpr.hs    |    7 ++++++-
 compiler/main/DynFlags.hs         |    4 +++-
 3 files changed, 12 insertions(+), 4 deletions(-)

diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 04297b4..627c189 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -527,9 +527,10 @@ getCallMethod :: DynFlags
               -> Maybe SelfLoopInfo -- can we perform a self-recursive tail call?
               -> CallMethod
 
-getCallMethod _ _ id _ n_args _cg_loc (Just (self_loop_id, block_id, args))
-  | id == self_loop_id, n_args == length args
+getCallMethod dflags _ id _ n_args _cg_loc (Just (self_loop_id, block_id, args))
+  | gopt Opt_Loopification dflags, id == self_loop_id, n_args == length args
   -- If these patterns match then we know that:
+  --   * loopification optimisation is turned on
   --   * function is performing a self-recursive call in a tail position
   --   * number of parameters of the function matches functions arity.
   -- See Note [Self-recursive tail calls] in StgCmmExpr for more details
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index c7fddd4..2f2cdbb 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -744,7 +744,12 @@ cgIdApp fun_id args = do
 --     recursive tail call when (a) environment stores information about
 --     possible self tail-call; (b) that tail call is to a function currently
 --     being compiled; (c) number of passed arguments is equal to function's
---     arity.
+--     arity. (d) loopification is turned on via -floopification command-line
+--     option.
+--
+--   * Command line option to control turn loopification on and off is
+--     implemented in DynFlags
+--
 
 
 emitEnter :: CmmExpr -> FCode ReturnKind
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index ada18b5..6f528a2 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -310,6 +310,7 @@ data GeneralFlag
    | Opt_FunToThunk               -- allow WwLib.mkWorkerArgs to remove all value lambdas
    | Opt_DictsStrict                     -- be strict in argument dictionaries
    | Opt_DmdTxDictSel              -- use a special demand transformer for dictionary selectors
+   | Opt_Loopification                  -- See Note [Self-recursive tail calls]
 
    -- Interface files
    | Opt_IgnoreInterfacePragmas
@@ -2606,7 +2607,8 @@ fFlags = [
   ( "kill-absence",                     Opt_KillAbsence, nop),
   ( "kill-one-shot",                    Opt_KillOneShot, nop),
   ( "dicts-strict",                     Opt_DictsStrict, nop ),
-  ( "dmd-tx-dict-sel",                  Opt_DmdTxDictSel, nop )
+  ( "dmd-tx-dict-sel",                  Opt_DmdTxDictSel, nop ),
+  ( "loopification",                    Opt_Loopification, nop )
   ]
 
 -- | These @-f\<blah\>@ flags can all be reversed with @-fno-\<blah\>@