Make -f[no-]method-sharing a dynamic flag

We want -Odph to be a dynamic flag and that should imply -fno-method-sharing.
This doesn't add a lot of complexity.

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 9e28d4c..d3019ee 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -248,6 +248,7 @@ data DynFlag
    | Opt_DoEtaReduction
    | Opt_CaseMerge
    | Opt_UnboxStrictFields
    | Opt_DoEtaReduction
    | Opt_CaseMerge
    | Opt_UnboxStrictFields

+   | Opt_MethodSharing

    | Opt_DictsCheap
    | Opt_RewriteRules
    | Opt_Vectorise
    | Opt_DictsCheap
    | Opt_RewriteRules
    | Opt_Vectorise

@@ -555,6 +556,8 @@ defaultDynFlags =
             Opt_ImplicitPrelude,
             Opt_MonomorphismRestriction,
 
             Opt_ImplicitPrelude,
             Opt_MonomorphismRestriction,
 

+            Opt_MethodSharing,
+

             Opt_DoAsmMangling,
 
             Opt_GenManifest,
             Opt_DoAsmMangling,
 
             Opt_GenManifest,

@@ -1271,6 +1274,7 @@ fFlags = [
   ( "do-eta-reduction",                 Opt_DoEtaReduction ),
   ( "case-merge",                       Opt_CaseMerge ),
   ( "unbox-strict-fields",              Opt_UnboxStrictFields ),
   ( "do-eta-reduction",                 Opt_DoEtaReduction ),
   ( "case-merge",                       Opt_CaseMerge ),
   ( "unbox-strict-fields",              Opt_UnboxStrictFields ),

+  ( "method-sharing",                   Opt_MethodSharing ),

   ( "dicts-cheap",                      Opt_DictsCheap ),
   ( "excess-precision",                 Opt_ExcessPrecision ),
   ( "asm-mangling",                     Opt_DoAsmMangling ),
   ( "dicts-cheap",                      Opt_DictsCheap ),
   ( "excess-precision",                 Opt_ExcessPrecision ),
   ( "asm-mangling",                     Opt_DoAsmMangling ),

diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index ad30803..be5fc53 100644 (file)
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -38,7 +38,6 @@ module StaticFlags (
        opt_Parallel,
 
        -- optimisation opts
        opt_Parallel,
 
        -- optimisation opts

-       opt_NoMethodSharing, 

        opt_NoStateHack,
        opt_SpecInlineJoinPoints,
        opt_CprOff,
        opt_NoStateHack,
        opt_SpecInlineJoinPoints,
        opt_CprOff,

@@ -317,8 +316,6 @@ opt_SpecInlineJoinPoints :: Bool
 opt_SpecInlineJoinPoints       = lookUp  (fsLit "-fspec-inline-join-points")
 opt_NoStateHack :: Bool
 opt_NoStateHack                        = lookUp  (fsLit "-fno-state-hack")
 opt_SpecInlineJoinPoints       = lookUp  (fsLit "-fspec-inline-join-points")
 opt_NoStateHack :: Bool
 opt_NoStateHack                        = lookUp  (fsLit "-fno-state-hack")

-opt_NoMethodSharing :: Bool
-opt_NoMethodSharing            = lookUp  (fsLit "-fno-method-sharing")

 opt_CprOff :: Bool
 opt_CprOff                     = lookUp  (fsLit "-fcpr-off")
        -- Switch off CPR analysis in the new demand analyser
 opt_CprOff :: Bool
 opt_CprOff                     = lookUp  (fsLit "-fcpr-off")
        -- Switch off CPR analysis in the new demand analyser

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index 1d83c8a..b844a2a 100644 (file)
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -785,7 +785,8 @@ instFun orig fun subst tv_theta_prs
        ; doStupidChecks fun ty_theta_prs'
 
                -- Now do normal instantiation
        ; doStupidChecks fun ty_theta_prs'
 
                -- Now do normal instantiation

-       ; result <- go True fun ty_theta_prs' 
+        ; method_sharing <- doptM Opt_MethodSharing
+       ; result <- go method_sharing True fun ty_theta_prs' 

        ; traceTc (text "instFun result" <+> ppr result)
        ; return result
        }
        ; traceTc (text "instFun result" <+> ppr result)
        ; return result
        }

@@ -793,24 +794,24 @@ instFun orig fun subst tv_theta_prs
     subst_pr (tvs, theta) 
        = (substTyVars subst tvs, substTheta subst theta)
 
     subst_pr (tvs, theta) 
        = (substTyVars subst tvs, substTheta subst theta)
 

-    go _ fun [] = do {traceTc (text "go _ fun [] returns" <+> ppr fun) ; return fun }
+    go _ _ fun [] = do {traceTc (text "go _ _ fun [] returns" <+> ppr fun) ; return fun }

 
 

-    go True (HsVar fun_id) ((tys,theta) : prs)
-       | want_method_inst theta
+    go method_sharing True (HsVar fun_id) ((tys,theta) : prs)
+       | want_method_inst method_sharing theta

        = do { traceTc (text "go (HsVar fun_id) ((tys,theta) : prs) | want_method_inst theta")
             ; meth_id <- newMethodWithGivenTy orig fun_id tys
        = do { traceTc (text "go (HsVar fun_id) ((tys,theta) : prs) | want_method_inst theta")
             ; meth_id <- newMethodWithGivenTy orig fun_id tys

-            ; go False (HsVar meth_id) prs }
+            ; go method_sharing False (HsVar meth_id) prs }

                -- Go round with 'False' to prevent further use
                -- of newMethod: see Note [Multiple instantiation]
 
                -- Go round with 'False' to prevent further use
                -- of newMethod: see Note [Multiple instantiation]
 

-    go _ fun ((tys, theta) : prs)
+    go method_sharing _ fun ((tys, theta) : prs)

        = do { co_fn <- instCall orig tys theta
             ; traceTc (text "go yields co_fn" <+> ppr co_fn)
        = do { co_fn <- instCall orig tys theta
             ; traceTc (text "go yields co_fn" <+> ppr co_fn)

-            ; go False (HsWrap co_fn fun) prs }
+            ; go method_sharing False (HsWrap co_fn fun) prs }

 
        -- See Note [No method sharing]
 
        -- See Note [No method sharing]

-    want_method_inst theta =  not (null theta) -- Overloaded
-                          && not opt_NoMethodSharing
+    want_method_inst method_sharing theta =  not (null theta)  -- Overloaded
+                                         && method_sharing

 \end{code}
 
 Note [Multiple instantiation]
 \end{code}
 
 Note [Multiple instantiation]

diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml
index 47b51a8..7de1ae8 100644 (file)
--- a/docs/users_guide/flags.xml
+++ b/docs/users_guide/flags.xml
@@ -1208,6 +1208,13 @@
            </row>
 
            <row>
            </row>
 
            <row>

+             <entry><option>-fmethod-sharing</option></entry>
+             <entry>Share specialisations of overloaded functions (default)</entry>
+             <entry>dynamic</entry>
+             <entry><option>-fno-method-sharing</option></entry>
+           </row>
+
+           <row>

              <entry><option>-fdo-eta-reduction</option></entry>
              <entry>Enable eta-reduction. Implied by <option>-O</option>.</entry>
              <entry>dynamic</entry>
              <entry><option>-fdo-eta-reduction</option></entry>
              <entry>Enable eta-reduction. Implied by <option>-O</option>.</entry>
              <entry>dynamic</entry>

@@ -2304,12 +2311,6 @@
              <entry>-</entry>
            </row>
            <row>
              <entry>-</entry>
            </row>
            <row>

-             <entry><option>-fno-method-sharing</option></entry>
-             <entry>Don't share specialisations of overloaded functions</entry>
-             <entry>static</entry>
-             <entry>-</entry>
-           </row>
-           <row>

              <entry><option>-fhistory-size</option></entry>
              <entry>Set simplification history size</entry>
              <entry>static</entry>
              <entry><option>-fhistory-size</option></entry>
              <entry>Set simplification history size</entry>
              <entry>static</entry>