New parameter -funshare-selectors
authorJoachim Breitner <mail@joachim-breitner.de>
Thu, 9 Aug 2012 14:39:29 +0000 (16:39 +0200)
committerJoachim Breitner <mail@joachim-breitner.de>
Tue, 28 Aug 2012 14:18:38 +0000 (16:18 +0200)
compiler/codeGen/CgExpr.lhs
compiler/main/DynFlags.hs

index 71c50bc..f5a8840 100644 (file)
@@ -368,12 +368,16 @@ mkRhsClosure :: DynFlags -> Id -> CostCentreStack -> StgBinderInfo
              -> FCode (Id, CgIdInfo)
 mkRhsClosure   dflags bndr cc bi
                [the_fv]                -- Just one free var
-               _upd_flag               -- Updatable thunk
+               upd_flag                -- Updatable thunk
                []                      -- A thunk
                body@(StgCase _ _ _ _ srt _ _)  -- ignore uniq, etc.
   | Just offset_into_int <- isSelectorThunk dflags [the_fv] [] body
-  = let lf_info  = mkSelectorLFInfo bndr offset_into_int ReEntrant
+  = let lf_info  = mkSelectorLFInfo bndr offset_into_int upd_flag'
     in  setSRT srt $ cgStdRhsClosure bndr cc bi [the_fv] [] body lf_info [StgVarArg the_fv]
+  where
+    upd_flag' = if upd_flag == Updatable && dopt Opt_UnshareSelectors dflags
+                then ReEntrant
+                else upd_flag
 \end{code}
 
 Ap thunks
index ff71582..1985a53 100644 (file)
@@ -301,6 +301,7 @@ data DynFlag
    | Opt_SplitObjs
    | Opt_StgStats
    | Opt_StgUnshare
+   | Opt_UnshareSelectors
    | Opt_HideAllPackages
    | Opt_PrintBindResult
    | Opt_Haddock
@@ -1844,6 +1845,7 @@ dynamic_flags = [
   , Flag "fstrictness-before"          (intSuffix (\n d -> d{ strictnessBefore = n : strictnessBefore d }))
   , Flag "ffloat-lam-args"             (intSuffix (\n d -> d{ floatLamArgs = Just n }))
   , Flag "ffloat-all-lams"             (noArg (\d -> d{ floatLamArgs = Nothing }))
+  , Flag "funshare-selectors"          (NoArg (setDynFlag Opt_UnshareSelectors))
 
         ------ Profiling ----------------------------------------------------