Fixs

4 files changed, 15 insertions, 11 deletions

diff --git a/compiler/GHC/Builtin/primops.txt.pp b/compiler/GHC/Builtin/primops.txt.pp
index 7fedb7db18..6346383023 100644
--- a/compiler/GHC/Builtin/primops.txt.pp
+++ b/compiler/GHC/Builtin/primops.txt.pp
@@ -1570,7 +1570,7 @@ primop  NewSmallArrayOp "newSmallArray#" GenPrimOp
    out_of_line = True
    has_side_effects = True
 
-primop SmallArrayOfOp "smallArrayOf#" GenPrimOp
+primop  SmallArrayOfOp "smallArrayOf#" GenPrimOp
    o -> SmallArray# b
    {Create a new immutable array from the elements passed in an arbitrarily
    nested homogeneous (i.e. after flattening all elements must be of the same
diff --git a/compiler/GHC/Stg/Pipeline.hs b/compiler/GHC/Stg/Pipeline.hs
index 65794bf0c2..b0e1848f19 100644
--- a/compiler/GHC/Stg/Pipeline.hs
+++ b/compiler/GHC/Stg/Pipeline.hs
@@ -83,6 +83,9 @@ stg2stg logger dflags ictxt for_bytecode this_mod binds
     do_stg_pass :: [StgTopBinding] -> StgToDo -> StgM [StgTopBinding]
     do_stg_pass binds to_do
       = case to_do of
+          StgDoNothing ->
+            return binds
+
           StgStats ->
             logTraceMsg logger "STG stats" (text (showStgStats binds)) (return binds)
 
@@ -149,9 +152,10 @@ getStgToDo for_bytecode dflags =
     , optional Opt_StgLiftLams StgLiftLams
     , runWhen for_bytecode StgBcPrep
     , optional Opt_StgStats StgStats
-    ]
-    where
-      optional opt x
-        | gopt opt dflags = Just x
-        | otherwise = Nothing
-      mandatory = Just
+    ] where
+      optional opt = runWhen (gopt opt dflags)
+      mandatory = id
+
+runWhen :: Bool -> StgToDo -> StgToDo
+runWhen True todo = todo
+runWhen _    _    = StgDoNothing
diff --git a/compiler/GHC/StgToCmm/Heap.hs b/compiler/GHC/StgToCmm/Heap.hs
index 5ab6dd9eb5..d22d1ca349 100644
--- a/compiler/GHC/StgToCmm/Heap.hs
+++ b/compiler/GHC/StgToCmm/Heap.hs
@@ -179,7 +179,7 @@ mkStaticClosureFields profile info_tbl ccs caf_refs payload
     platform = profilePlatform profile
     info_lbl = cit_lbl info_tbl
     header = case cit_rep info_tbl of
-      SmallArrayPtrsRep size -> [mkIntCLit (targetPlatform dflags) size]
+      SmallArrayPtrsRep size -> [mkIntCLit platform size]
       _ -> []
 
     -- CAFs must have consistent layout, regardless of whether they
@@ -227,7 +227,7 @@ mkStaticClosureFields profile info_tbl ccs caf_refs payload
 
 mkStaticClosure :: Profile -> CLabel -> CostCentreStack -> [CmmLit] -> [CmmLit]
   -> [CmmLit] -> [CmmLit] -> [CmmLit] -> [CmmLit]
-mkStaticClosure dflags info_lbl ccs header payload padding static_link_field saved_info_field
+mkStaticClosure profile info_lbl ccs header payload padding static_link_field saved_info_field
   =  [CmmLabel info_lbl]
   ++ staticProfHdr profile ccs
   ++ header
diff --git a/compiler/GHC/StgToCmm/Prim.hs b/compiler/GHC/StgToCmm/Prim.hs
index 49cf10e33d..bce547fea4 100644
--- a/compiler/GHC/StgToCmm/Prim.hs
+++ b/compiler/GHC/StgToCmm/Prim.hs
@@ -226,7 +226,7 @@ emitPrimOp dflags primop = case primop of
         (replicate (fromIntegral n) init)
     _ -> PrimopCmmEmit_External
 
-  op@SmallArrayOfOp -> \elems -> opAllDone $ \[res] -> do
+  op@SmallArrayOfOp -> \elems -> opIntoRegs $ \[res] -> do
     let n = length elems
     case allStatic elems of
       Just known -> do
@@ -239,7 +239,7 @@ emitPrimOp dflags primop = case primop of
         (smallArrPtrsRep (fromIntegral n))
         mkSMAP_FROZEN_DIRTY_infoLabel
         [ ( mkIntExpr platform n
-          , fixedHdrSize dflags + oFFSET_StgSmallMutArrPtrs_ptrs dflags ) ]
+          , fixedHdrSize profile + pc_OFFSET_StgSmallMutArrPtrs_ptrs (platformConstants platform) ) ]
         elems
       where
         -- todo: comment