Merge remote-tracking branch 'origin/master' into newcg

* origin/master: (756 commits)
  don't crash if argv[0] == NULL (#7037)
  -package P was loading all versions of P in GHCi (#7030)
  Add a Note, copying text from #2437
  improve the --help docs a bit (#7008)
  Copy Data.HashTable's hashString into our Util module
  Build fix
  Build fixes
  Parse error: suggest brackets and indentation.
  Don't build the ghc DLL on Windows; works around trac #5987
  On Windows, detect if DLLs have too many symbols; trac #5987
  Add some more Integer rules; fixes #6111
  Fix PA dfun construction with silent superclass args
  Add silent superclass parameters to the vectoriser
  Add silent superclass parameters (again)
  Mention Generic1 in the user's guide
  Make the GHC API a little more powerful.
  tweak llvm version warning message
  New version of the patch for #5461.
  Fix Word64ToInteger conversion rule.
  Implemented feature request on reconfigurable pretty-printing in GHCi (#5461)
  ...

Conflicts:
	compiler/basicTypes/UniqSupply.lhs
	compiler/cmm/CmmBuildInfoTables.hs
	compiler/cmm/CmmLint.hs
	compiler/cmm/CmmOpt.hs
	compiler/cmm/CmmPipeline.hs
	compiler/cmm/CmmStackLayout.hs
	compiler/cmm/MkGraph.hs
	compiler/cmm/OldPprCmm.hs
	compiler/codeGen/CodeGen.lhs
	compiler/codeGen/StgCmm.hs
	compiler/codeGen/StgCmmBind.hs
	compiler/codeGen/StgCmmLayout.hs
	compiler/codeGen/StgCmmUtils.hs
	compiler/main/CodeOutput.lhs
	compiler/main/HscMain.hs
	compiler/nativeGen/AsmCodeGen.lhs
	compiler/simplStg/SimplStg.lhs

32 files changed, 460 insertions, 258 deletions

diff --git a/compiler/codeGen/CgBindery.lhs b/compiler/codeGen/CgBindery.lhs
index 198e192f5c..0efc99d370 100644
--- a/compiler/codeGen/CgBindery.lhs
+++ b/compiler/codeGen/CgBindery.lhs
@@ -146,10 +146,10 @@ data StableLoc
                 -- be saved, so it makes sense to treat treat them as
                 -- having a stable location
 
-instance PlatformOutputable CgIdInfo where
-  pprPlatform platform (CgIdInfo id _ vol stb _ _)
+instance Outputable CgIdInfo where
+  ppr (CgIdInfo id _ vol stb _ _)
     -- TODO, pretty pring the tag info
-    = ppr id <+> ptext (sLit "-->") <+> vcat [ppr vol, pprPlatform platform stb]
+    = ppr id <+> ptext (sLit "-->") <+> vcat [ppr vol, ppr stb]
 
 instance Outputable VolatileLoc where
   ppr NoVolatileLoc = empty
@@ -157,12 +157,12 @@ instance Outputable VolatileLoc where
   ppr (VirHpLoc v)   = ptext (sLit "vh")  <+> ppr v
   ppr (VirNodeLoc v) = ptext (sLit "vn")  <+> ppr v
 
-instance PlatformOutputable StableLoc where
-  pprPlatform _        NoStableLoc   = empty
-  pprPlatform _        VoidLoc       = ptext (sLit "void")
-  pprPlatform _        (VirStkLoc v) = ptext (sLit "vs")    <+> ppr v
-  pprPlatform _        (VirStkLNE v) = ptext (sLit "lne")   <+> ppr v
-  pprPlatform platform (StableLoc a) = ptext (sLit "amode") <+> pprPlatform platform a
+instance Outputable StableLoc where
+  ppr NoStableLoc   = empty
+  ppr VoidLoc       = ptext (sLit "void")
+  ppr (VirStkLoc v) = ptext (sLit "vs")    <+> ppr v
+  ppr (VirStkLNE v) = ptext (sLit "lne")   <+> ppr v
+  ppr (StableLoc a) = ptext (sLit "amode") <+> ppr a
 \end{code}
 
 %************************************************************************
@@ -411,15 +411,12 @@ getArgAmode (StgLitArg lit)
   = do  { cmm_lit <- cgLit lit
         ; return (typeCgRep (literalType lit), CmmLit cmm_lit) }
 
-getArgAmode (StgTypeArg _) = panic "getArgAmode: type arg"
-
 getArgAmodes :: [StgArg] -> FCode [(CgRep, CmmExpr)]
 getArgAmodes [] = returnFC []
 getArgAmodes (atom:atoms)
-  | isStgTypeArg atom = getArgAmodes atoms
-  | otherwise         = do { amode  <- getArgAmode  atom 
-                           ; amodes <- getArgAmodes atoms
-                           ; return ( amode : amodes ) }
+  = do { amode  <- getArgAmode  atom 
+       ; amodes <- getArgAmodes atoms
+       ; return ( amode : amodes ) }
 \end{code}
 
 %************************************************************************
diff --git a/compiler/codeGen/CgCase.lhs b/compiler/codeGen/CgCase.lhs
index dd607de1fc..745bf47710 100644
--- a/compiler/codeGen/CgCase.lhs
+++ b/compiler/codeGen/CgCase.lhs
@@ -520,7 +520,6 @@ cgAlgAlts gc_flag cc_slot alt_type alts
 
             branches = [(dataConTagZ con, blks)
                        | (DataAlt con, blks) <- alts]
-       -- in
        return (branches, mb_deflt)
 
 
diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs
index d6537c27e5..8f98a5f764 100644
--- a/compiler/codeGen/CgClosure.lhs
+++ b/compiler/codeGen/CgClosure.lhs
@@ -81,7 +81,8 @@ cgTopRhsClosure id ccs binder_info upd_flag args body = do
   ; lf_info  <- mkClosureLFInfo id TopLevel [] upd_flag args
   ; srt_info <- getSRTInfo
   ; mod_name <- getModuleName
-  ; let descr         = closureDescription mod_name name
+  ; dflags   <- getDynFlags
+  ; let descr         = closureDescription dflags mod_name name
 	closure_info  = mkClosureInfo True id lf_info 0 0 srt_info descr
 	closure_label = mkLocalClosureLabel name $ idCafInfo id
     	cg_id_info    = stableIdInfo id (mkLblExpr closure_label) lf_info
@@ -120,10 +121,11 @@ cgStdRhsClosure bndr _cc _bndr_info _fvs _args _body lf_info payload
   {	-- LAY OUT THE OBJECT
     amodes <- getArgAmodes payload
   ; mod_name <- getModuleName
+  ; dflags <- getDynFlags
   ; let (tot_wds, ptr_wds, amodes_w_offsets) 
 	    = mkVirtHeapOffsets (isLFThunk lf_info) amodes
 
-	descr	     = closureDescription mod_name (idName bndr)
+	descr	     = closureDescription dflags mod_name (idName bndr)
 	closure_info = mkClosureInfo False 	-- Not static
 				     bndr lf_info tot_wds ptr_wds 
 				     NoC_SRT	-- No SRT for a std-form closure
@@ -169,13 +171,14 @@ cgRhsClosure bndr cc bndr_info fvs upd_flag args body = do
   ; fv_infos <- mapFCs getCgIdInfo reduced_fvs
   ; srt_info <- getSRTInfo
   ; mod_name <- getModuleName
+  ; dflags <- getDynFlags
   ; let	bind_details :: [(CgIdInfo, VirtualHpOffset)]
 	(tot_wds, ptr_wds, bind_details) 
 	   = mkVirtHeapOffsets (isLFThunk lf_info) (map add_rep fv_infos)
 
 	add_rep info = (cgIdInfoArgRep info, info)
 
-	descr	     = closureDescription mod_name name
+	descr	     = closureDescription dflags mod_name name
 	closure_info = mkClosureInfo False	-- Not static
 				     bndr lf_info tot_wds ptr_wds
 				     srt_info descr
@@ -485,7 +488,7 @@ emitBlackHoleCode is_single_entry = do
     stmtsC [
        CmmStore (cmmOffsetW (CmmReg nodeReg) fixedHdrSize)
                 (CmmReg (CmmGlobal CurrentTSO)),
-       CmmCall (CmmPrim MO_WriteBarrier) [] [] CmmMayReturn,
+       CmmCall (CmmPrim MO_WriteBarrier Nothing) [] [] CmmMayReturn,
        CmmStore (CmmReg nodeReg) (CmmReg (CmmGlobal EagerBlackholeInfo))
      ]
 \end{code}
@@ -506,9 +509,10 @@ setupUpdate closure_info code
       else do
           tickyPushUpdateFrame
           dflags <- getDynFlags
-          if not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags
-              then pushBHUpdateFrame (CmmReg nodeReg) code
-              else pushUpdateFrame   (CmmReg nodeReg) code
+          if blackHoleOnEntry closure_info &&
+             not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags
+               then pushBHUpdateFrame (CmmReg nodeReg) code
+               else pushUpdateFrame   (CmmReg nodeReg) code
   
   | otherwise	-- A static closure
   = do 	{ tickyUpdateBhCaf closure_info
@@ -612,13 +616,14 @@ name of the data constructor itself.  Otherwise it is determined by
 @closureDescription@ from the let binding information.
 
 \begin{code}
-closureDescription :: Module		-- Module
-		   -> Name		-- Id of closure binding
-		   -> String
+closureDescription :: DynFlags
+                   -> Module    -- Module
+                   -> Name      -- Id of closure binding
+                   -> String
 	-- Not called for StgRhsCon which have global info tables built in
 	-- CgConTbls.lhs with a description generated from the data constructor
-closureDescription mod_name name
-  = showSDocDumpOneLine (char '<' <>
+closureDescription dflags mod_name name
+  = showSDocDumpOneLine dflags (char '<' <>
 		    (if isExternalName name
 		      then ppr name -- ppr will include the module name prefix
 		      else pprModule mod_name <> char '.' <> ppr name) <>
diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index 9049504dca..aff5e468ca 100644
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -72,13 +72,12 @@ cgTopRhsCon id con args
         ; when (platformOS (targetPlatform dflags) == OSMinGW32) $
               -- Windows DLLs have a problem with static cross-DLL refs.
               ASSERT( not (isDllConApp dflags con args) ) return ()
-        ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
+        ; ASSERT( args `lengthIs` dataConRepRepArity con ) return ()
 
         -- LAY IT OUT
         ; amodes <- getArgAmodes args
 
         ; let
-            platform = targetPlatform dflags
             name          = idName id
             lf_info       = mkConLFInfo con
             closure_label = mkClosureLabel name $ idCafInfo id
@@ -92,7 +91,7 @@ cgTopRhsCon id con args
 
             payload = map get_lit amodes_w_offsets
             get_lit (CmmLit lit, _offset) = lit
-            get_lit other = pprPanic "CgCon.get_lit" (pprPlatform platform other)
+            get_lit other = pprPanic "CgCon.get_lit" (ppr other)
                 -- NB1: amodes_w_offsets is sorted into ptrs first, then non-ptrs
                 -- NB2: all the amodes should be Lits!
 
@@ -324,7 +323,7 @@ cgReturnDataCon con amodes
       -- for it to be marked as "used" for LDV profiling.
   | opt_SccProfilingOn    = build_it_then enter_it
   | otherwise
-  = ASSERT( amodes `lengthIs` dataConRepArity con )
+  = ASSERT( amodes `lengthIs` dataConRepRepArity con )
     do  { EndOfBlockInfo _ sequel <- getEndOfBlockInfo
         ; case sequel of
             CaseAlts _ (Just (alts, deflt_lbl)) bndr
@@ -466,8 +465,8 @@ cgDataCon data_con
                                 ; ldvEnter (CmmReg nodeReg)
                                 ; body_code }
 
-            arg_reps :: [(CgRep, Type)]
-            arg_reps = [(typeCgRep ty, ty) | ty <- dataConRepArgTys data_con]
+            arg_reps :: [(CgRep, UnaryType)]
+            arg_reps = [(typeCgRep rep_ty, rep_ty) | ty <- dataConRepArgTys data_con, rep_ty <- flattenRepType (repType ty)]
 
             body_code = do {
                         -- NB: We don't set CC when entering data (WDP 94/06)
diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs
index cb3a86ef7f..f935f95726 100644
--- a/compiler/codeGen/CgExpr.lhs
+++ b/compiler/codeGen/CgExpr.lhs
@@ -480,7 +480,7 @@ Little helper for primitives that return unboxed tuples.
 newUnboxedTupleRegs :: Type -> FCode ([CgRep], [LocalReg], [ForeignHint])
 newUnboxedTupleRegs res_ty =
    let
-	ty_args = tyConAppArgs (repType res_ty)
+	UbxTupleRep ty_args = repType res_ty
 	(reps,hints) = unzip [ (rep, typeForeignHint ty) | ty <- ty_args,
 					   	    let rep = typeCgRep ty,
 					 	    nonVoidArg rep ]
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index 09636bc6b2..e957b90b20 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -59,7 +59,6 @@ cgForeignCall results fcall stg_args live
 
         arg_hints = zipWith CmmHinted
                       arg_exprs (map (typeForeignHint.stgArgType) stg_args)
-  -- in
   emitForeignCall results fcall arg_hints live
 
 
@@ -78,9 +77,11 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
   where
       (call_args, cmm_target)
         = case target of
+           StaticTarget _   _      False ->
+               panic "emitForeignCall: unexpected FFI value import"
            -- If the packageId is Nothing then the label is taken to be in the
            --   package currently being compiled.
-           StaticTarget lbl mPkgId
+           StaticTarget lbl mPkgId True
             -> let labelSource
                         = case mPkgId of
                                 Nothing         -> ForeignLabelInThisPackage
@@ -309,4 +310,5 @@ shimForeignCallArg arg expr
   | otherwise = expr
   where
         -- should be a tycon app, since this is a foreign call
-        tycon = tyConAppTyCon (repType (stgArgType arg))
+        UnaryRep rep_ty = repType (stgArgType arg)
+        tycon           = tyConAppTyCon rep_ty
diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs
index f98d579e62..7cdb1b6f7e 100644
--- a/compiler/codeGen/CgInfoTbls.hs
+++ b/compiler/codeGen/CgInfoTbls.hs
@@ -45,7 +45,6 @@ import Unique
 import StaticFlags
 
 import Constants
-import DynFlags
 import Util
 import Outputable
 
@@ -150,8 +149,6 @@ is not present in the list (it is always assumed).
 -}
 mkStackLayout :: FCode [Maybe LocalReg]
 mkStackLayout = do
-  dflags <- getDynFlags
-  let platform = targetPlatform dflags
   StackUsage { realSp = real_sp,
                frameSp = frame_sp } <- getStkUsage
   binds <- getLiveStackBindings
@@ -161,7 +158,7 @@ mkStackLayout = do
                     | (offset, b) <- binds]
 
   WARN( not (all (\bind -> fst bind >= 0) rel_binds),
-        pprPlatform platform binds $$ pprPlatform platform rel_binds $$
+        ppr binds $$ ppr rel_binds $$
         ppr frame_size $$ ppr real_sp $$ ppr frame_sp )
     return $ stack_layout rel_binds frame_size
 
diff --git a/compiler/codeGen/CgMonad.lhs b/compiler/codeGen/CgMonad.lhs
index dff54f3bf5..71da9e9ae0 100644
--- a/compiler/codeGen/CgMonad.lhs
+++ b/compiler/codeGen/CgMonad.lhs
@@ -77,6 +77,7 @@ import VarEnv
 import OrdList
 import Unique
 import UniqSupply
+import Util
 import Outputable
 
 import Control.Monad
diff --git a/compiler/codeGen/CgParallel.hs b/compiler/codeGen/CgParallel.hs
index 2804104708..c86ef9e34a 100644
--- a/compiler/codeGen/CgParallel.hs
+++ b/compiler/codeGen/CgParallel.hs
@@ -3,78 +3,73 @@
 -- (c) The University of Glasgow -2006
 --
 -- Code generation relaed to GpH
--- 	(a) parallel
---	(b) GranSim
+--      (a) parallel
+--      (b) GranSim
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module CgParallel(
-	staticGranHdr,staticParHdr,
-	granFetchAndReschedule, granYield,
-	doGranAllocate
+        staticGranHdr,staticParHdr,
+        granFetchAndReschedule, granYield,
+        doGranAllocate
   ) where
 
 import CgMonad
 import CgCallConv
+import DynFlags
 import Id
 import OldCmm
-import StaticFlags
 import Outputable
 import SMRep
 
+import Control.Monad
+
 staticParHdr :: [CmmLit]
 -- Parallel header words in a static closure
 staticParHdr = []
 
 --------------------------------------------------------
---		GranSim stuff
+--              GranSim stuff
 --------------------------------------------------------
 
 staticGranHdr :: [CmmLit]
 -- Gransim header words in a static closure
 staticGranHdr = []
 
-doGranAllocate :: CmmExpr -> Code	
+doGranAllocate :: CmmExpr -> Code
 -- macro DO_GRAN_ALLOCATE
 doGranAllocate _hp
-  | not opt_GranMacros = nopC
-  | otherwise	       = panic "doGranAllocate"
+  = do dflags <- getDynFlags
+       when (dopt Opt_GranMacros dflags) $ panic "doGranAllocate"
 
 
 
 -------------------------
 granFetchAndReschedule :: [(Id,GlobalReg)]  -- Live registers
-		       -> Bool           	-- Node reqd?
-		       -> Code
+                       -> Bool                  -- Node reqd?
+                       -> Code
 -- Emit code for simulating a fetch and then reschedule.
 granFetchAndReschedule regs node_reqd
-  | opt_GranMacros && (node `elem` map snd regs || node_reqd)
-  = do { fetch
-       ; reschedule liveness node_reqd }
-  | otherwise
-  = nopC
+  = do dflags <- getDynFlags
+       when (dopt Opt_GranMacros dflags &&
+             (node `elem` map snd regs || node_reqd)) $
+           do fetch
+              reschedule liveness node_reqd
   where
     liveness = mkRegLiveness regs 0 0
 
 fetch :: FCode ()
 fetch = panic "granFetch"
-	-- Was: absC (CMacroStmt GRAN_FETCH [])
-	--HWL: generate GRAN_FETCH macro for GrAnSim
- 	--     currently GRAN_FETCH and GRAN_FETCH_AND_RESCHEDULE are miai
+        -- Was: absC (CMacroStmt GRAN_FETCH [])
+        --HWL: generate GRAN_FETCH macro for GrAnSim
+        --     currently GRAN_FETCH and GRAN_FETCH_AND_RESCHEDULE are miai
 
 reschedule :: StgWord -> Bool -> Code
 reschedule _liveness _node_reqd = panic "granReschedule"
-	-- Was: absC  (CMacroStmt GRAN_RESCHEDULE [
-  	--                mkIntCLit (I# (word2Int# liveness_mask)), 
-    	--		  mkIntCLit (if node_reqd then 1 else 0)])
-    
+        -- Was: absC  (CMacroStmt GRAN_RESCHEDULE [
+        --                mkIntCLit (I# (word2Int# liveness_mask)),
+        --                mkIntCLit (if node_reqd then 1 else 0)])
+
 
 -------------------------
 -- The @GRAN_YIELD@ macro is taken from JSM's  code for Concurrent Haskell. It
@@ -82,26 +77,26 @@ reschedule _liveness _node_reqd = panic "granReschedule"
 -- @Continue@ rather  than the @EnterNodeCode@  function in the  RTS). We emit
 -- this kind of macro at the beginning of the following kinds of basic bocks:
 -- \begin{itemize}
---  \item Slow entry code where node is not alive (see @CgClosure.lhs@). Normally 
+--  \item Slow entry code where node is not alive (see @CgClosure.lhs@). Normally
 --        we use @fetchAndReschedule@ at a slow entry code.
 --  \item Fast entry code (see @CgClosure.lhs@).
 --  \item Alternatives in case expressions (@CLabelledCode@ structures), provided
---        that they are not inlined (see @CgCases.lhs@). These alternatives will 
+--        that they are not inlined (see @CgCases.lhs@). These alternatives will
 --        be turned into separate functions.
 
 granYield :: [(Id,GlobalReg)]   -- Live registers
           -> Bool               -- Node reqd?
-          -> Code 
+          -> Code
 
 granYield regs node_reqd
-  | opt_GranMacros && node_reqd = yield liveness
-  | otherwise			= nopC
+  = do dflags <- getDynFlags
+       when (dopt Opt_GranMacros dflags && node_reqd) $ yield liveness
   where
      liveness = mkRegLiveness regs 0 0
 
 yield :: StgWord -> Code
 yield _liveness = panic "granYield"
-	-- Was : absC (CMacroStmt GRAN_YIELD 
+        -- Was : absC (CMacroStmt GRAN_YIELD
         --                  [mkIntCLit (I# (word2Int# liveness_mask))])
 
 
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index b0865d69d9..641cd5d1dc 100644
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -33,6 +33,8 @@ import Outputable
 import FastString
 import StaticFlags
 
+import Control.Monad
+
 -- ---------------------------------------------------------------------------
 -- Code generation for PrimOps
 
@@ -402,12 +404,14 @@ emitPrimOp res WriteByteArrayOp_Word16    args _ = doWriteByteArrayOp (Just mo_W
 emitPrimOp res WriteByteArrayOp_Word32    args _ = doWriteByteArrayOp (Just mo_WordTo32) b32  res args
 emitPrimOp res WriteByteArrayOp_Word64    args _ = doWriteByteArrayOp Nothing b64  res args
 
--- Copying byte arrays
+-- Copying and setting byte arrays
 
 emitPrimOp [] CopyByteArrayOp [src,src_off,dst,dst_off,n] live =
     doCopyByteArrayOp src src_off dst dst_off n live
 emitPrimOp [] CopyMutableByteArrayOp [src,src_off,dst,dst_off,n] live =
     doCopyMutableByteArrayOp src src_off dst dst_off n live
+emitPrimOp [] SetByteArrayOp [ba,off,len,c] live =
+    doSetByteArrayOp ba off len c live
 
 -- Population count
 emitPrimOp [res] PopCnt8Op [w] live = emitPopCntCall res w W8 live
@@ -430,7 +434,7 @@ emitPrimOp [res] op args live
    = do vols <- getVolatileRegs live
         emitForeignCall' PlayRisky
            [CmmHinted res NoHint]
-           (CmmPrim prim)
+           (CmmPrim prim Nothing)
            [CmmHinted a NoHint | a<-args]  -- ToDo: hints?
            (Just vols)
            NoC_SRT -- No SRT b/c we do PlayRisky
@@ -440,9 +444,167 @@ emitPrimOp [res] op args live
    = let stmt = CmmAssign (CmmLocal res) (CmmMachOp mop args) in
      stmtC stmt
 
+emitPrimOp [res_q, res_r] IntQuotRemOp [arg_x, arg_y] _
+    = let genericImpl
+              = [CmmAssign (CmmLocal res_q)
+                           (CmmMachOp (MO_S_Quot wordWidth) [arg_x, arg_y]),
+                 CmmAssign (CmmLocal res_r)
+                           (CmmMachOp (MO_S_Rem  wordWidth) [arg_x, arg_y])]
+          stmt = CmmCall (CmmPrim (MO_S_QuotRem wordWidth) (Just genericImpl))
+                         [CmmHinted res_q NoHint,
+                          CmmHinted res_r NoHint]
+                         [CmmHinted arg_x NoHint,
+                          CmmHinted arg_y NoHint]
+                         CmmMayReturn
+      in stmtC stmt
+emitPrimOp [res_q, res_r] WordQuotRemOp [arg_x, arg_y] _
+    = let genericImpl
+              = [CmmAssign (CmmLocal res_q)
+                           (CmmMachOp (MO_U_Quot wordWidth) [arg_x, arg_y]),
+                 CmmAssign (CmmLocal res_r)
+                           (CmmMachOp (MO_U_Rem  wordWidth) [arg_x, arg_y])]
+          stmt = CmmCall (CmmPrim (MO_U_QuotRem wordWidth) (Just genericImpl))
+                         [CmmHinted res_q NoHint,
+                          CmmHinted res_r NoHint]
+                         [CmmHinted arg_x NoHint,
+                          CmmHinted arg_y NoHint]
+                         CmmMayReturn
+      in stmtC stmt
+emitPrimOp [res_q, res_r] WordQuotRem2Op [arg_x_high, arg_x_low, arg_y] _
+    = do let ty = cmmExprType arg_x_high
+             shl   x i = CmmMachOp (MO_Shl   wordWidth) [x, i]
+             shr   x i = CmmMachOp (MO_U_Shr wordWidth) [x, i]
+             or    x y = CmmMachOp (MO_Or    wordWidth) [x, y]
+             ge    x y = CmmMachOp (MO_U_Ge  wordWidth) [x, y]
+             ne    x y = CmmMachOp (MO_Ne    wordWidth) [x, y]
+             minus x y = CmmMachOp (MO_Sub   wordWidth) [x, y]
+             times x y = CmmMachOp (MO_Mul   wordWidth) [x, y]
+             zero   = lit 0
+             one    = lit 1
+             negone = lit (fromIntegral (widthInBits wordWidth) - 1)
+             lit i = CmmLit (CmmInt i wordWidth)
+             f :: Int -> CmmExpr -> CmmExpr -> CmmExpr -> FCode [CmmStmt]
+             f 0 acc high _ = return [CmmAssign (CmmLocal res_q) acc,
+                                      CmmAssign (CmmLocal res_r) high]
+             f i acc high low =
+                 do roverflowedBit <- newLocalReg ty
+                    rhigh'         <- newLocalReg ty
+                    rhigh''        <- newLocalReg ty
+                    rlow'          <- newLocalReg ty
+                    risge          <- newLocalReg ty
+                    racc'          <- newLocalReg ty
+                    let high'         = CmmReg (CmmLocal rhigh')
+                        isge          = CmmReg (CmmLocal risge)
+                        overflowedBit = CmmReg (CmmLocal roverflowedBit)
+                    let this = [CmmAssign (CmmLocal roverflowedBit)
+                                          (shr high negone),
+                                CmmAssign (CmmLocal rhigh')
+                                          (or (shl high one) (shr low negone)),
+                                CmmAssign (CmmLocal rlow')
+                                          (shl low one),
+                                CmmAssign (CmmLocal risge)
+                                          (or (overflowedBit `ne` zero)
+                                              (high' `ge` arg_y)),
+                                CmmAssign (CmmLocal rhigh'')
+                                          (high' `minus` (arg_y `times` isge)),
+                                CmmAssign (CmmLocal racc')
+                                          (or (shl acc one) isge)]
+                    rest <- f (i - 1) (CmmReg (CmmLocal racc'))
+                                      (CmmReg (CmmLocal rhigh''))
+                                      (CmmReg (CmmLocal rlow'))
+                    return (this ++ rest)
+         genericImpl <- f (widthInBits wordWidth) zero arg_x_high arg_x_low
+         let stmt = CmmCall (CmmPrim (MO_U_QuotRem2 wordWidth) (Just genericImpl))
+                            [CmmHinted res_q NoHint,
+                             CmmHinted res_r NoHint]
+                            [CmmHinted arg_x_high NoHint,
+                             CmmHinted arg_x_low NoHint,
+                             CmmHinted arg_y NoHint]
+                            CmmMayReturn
+         stmtC stmt
+
+emitPrimOp [res_h, res_l] WordAdd2Op [arg_x, arg_y] _
+ = do r1 <- newLocalReg (cmmExprType arg_x)
+      r2 <- newLocalReg (cmmExprType arg_x)
+      -- This generic implementation is very simple and slow. We might
+      -- well be able to do better, but for now this at least works.
+      let genericImpl
+           = [CmmAssign (CmmLocal r1)
+                  (add (bottomHalf arg_x) (bottomHalf arg_y)),
+              CmmAssign (CmmLocal r2)
+                  (add (topHalf (CmmReg (CmmLocal r1)))
+                       (add (topHalf arg_x) (topHalf arg_y))),
+              CmmAssign (CmmLocal res_h)
+                  (topHalf (CmmReg (CmmLocal r2))),
+              CmmAssign (CmmLocal res_l)
+                  (or (toTopHalf (CmmReg (CmmLocal r2)))
+                      (bottomHalf (CmmReg (CmmLocal r1))))]
+               where topHalf x = CmmMachOp (MO_U_Shr wordWidth) [x, hww]
+                     toTopHalf x = CmmMachOp (MO_Shl wordWidth) [x, hww]
+                     bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
+                     add x y = CmmMachOp (MO_Add wordWidth) [x, y]
+                     or x y = CmmMachOp (MO_Or wordWidth) [x, y]
+                     hww = CmmLit (CmmInt (fromIntegral (widthInBits halfWordWidth))
+                                          wordWidth)
+                     hwm = CmmLit (CmmInt halfWordMask wordWidth)
+          stmt = CmmCall (CmmPrim (MO_Add2 wordWidth) (Just genericImpl))
+                         [CmmHinted res_h NoHint,
+                          CmmHinted res_l NoHint]
+                         [CmmHinted arg_x NoHint,
+                          CmmHinted arg_y NoHint]
+                         CmmMayReturn
+      stmtC stmt
+emitPrimOp [res_h, res_l] WordMul2Op [arg_x, arg_y] _
+ = do let t = cmmExprType arg_x
+      xlyl <- liftM CmmLocal $ newLocalReg t
+      xlyh <- liftM CmmLocal $ newLocalReg t
+      xhyl <- liftM CmmLocal $ newLocalReg t
+      r    <- liftM CmmLocal $ newLocalReg t
+      -- This generic implementation is very simple and slow. We might
+      -- well be able to do better, but for now this at least works.
+      let genericImpl
+           = [CmmAssign xlyl
+                  (mul (bottomHalf arg_x) (bottomHalf arg_y)),
+              CmmAssign xlyh
+                  (mul (bottomHalf arg_x) (topHalf arg_y)),
+              CmmAssign xhyl
+                  (mul (topHalf arg_x) (bottomHalf arg_y)),
+              CmmAssign r
+                  (sum [topHalf    (CmmReg xlyl),
+                        bottomHalf (CmmReg xhyl),
+                        bottomHalf (CmmReg xlyh)]),
+              CmmAssign (CmmLocal res_l)
+                  (or (bottomHalf (CmmReg xlyl))
+                      (toTopHalf (CmmReg r))),
+              CmmAssign (CmmLocal res_h)
+                  (sum [mul (topHalf arg_x) (topHalf arg_y),
+                        topHalf (CmmReg xhyl),
+                        topHalf (CmmReg xlyh),
+                        topHalf (CmmReg r)])]
+               where topHalf x = CmmMachOp (MO_U_Shr wordWidth) [x, hww]
+                     toTopHalf x = CmmMachOp (MO_Shl wordWidth) [x, hww]
+                     bottomHalf x = CmmMachOp (MO_And wordWidth) [x, hwm]
+                     add x y = CmmMachOp (MO_Add wordWidth) [x, y]
+                     sum = foldl1 add
+                     mul x y = CmmMachOp (MO_Mul wordWidth) [x, y]
+                     or x y = CmmMachOp (MO_Or wordWidth) [x, y]
+                     hww = CmmLit (CmmInt (fromIntegral (widthInBits halfWordWidth))
+                                          wordWidth)
+                     hwm = CmmLit (CmmInt halfWordMask wordWidth)
+          stmt = CmmCall (CmmPrim (MO_U_Mul2 wordWidth) (Just genericImpl))
+                         [CmmHinted res_h NoHint,
+                          CmmHinted res_l NoHint]
+                         [CmmHinted arg_x NoHint,
+                          CmmHinted arg_y NoHint]
+                         CmmMayReturn
+      stmtC stmt
+
 emitPrimOp _ op _ _
  = pprPanic "emitPrimOp: can't translate PrimOp" (ppr op)
 
+newLocalReg :: CmmType -> FCode LocalReg
+newLocalReg t = do u <- newUnique
+                   return $ LocalReg u t
 
 -- These PrimOps are NOPs in Cmm
 
@@ -748,6 +910,18 @@ emitCopyByteArray copy src src_off dst dst_off n live = do
     copy src dst dst_p src_p n live
 
 -- ----------------------------------------------------------------------------
+-- Setting byte arrays
+
+-- | Takes a 'MutableByteArray#', an offset into the array, a length,
+-- and a byte, and sets each of the selected bytes in the array to the
+-- character.
+doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
+                 -> StgLiveVars -> Code
+doSetByteArrayOp ba off len c live
+    = do p <- assignTemp $ cmmOffsetExpr (cmmOffsetB ba arrWordsHdrSize) off
+         emitMemsetCall p c len (CmmLit (mkIntCLit 1)) live
+
+-- ----------------------------------------------------------------------------
 -- Copying pointer arrays
 
 -- EZY: This code has an unusually high amount of assignTemp calls, seen
@@ -889,7 +1063,7 @@ emitMemcpyCall dst src n align live = do
     vols <- getVolatileRegs live
     emitForeignCall' PlayRisky
         [{-no results-}]
-        (CmmPrim MO_Memcpy)
+        (CmmPrim MO_Memcpy Nothing)
         [ (CmmHinted dst AddrHint)
         , (CmmHinted src AddrHint)
         , (CmmHinted n NoHint)
@@ -906,7 +1080,7 @@ emitMemmoveCall dst src n align live = do
     vols <- getVolatileRegs live
     emitForeignCall' PlayRisky
         [{-no results-}]
-        (CmmPrim MO_Memmove)
+        (CmmPrim MO_Memmove Nothing)
         [ (CmmHinted dst AddrHint)
         , (CmmHinted src AddrHint)
         , (CmmHinted n NoHint)
@@ -924,7 +1098,7 @@ emitMemsetCall dst c n align live = do
     vols <- getVolatileRegs live
     emitForeignCall' PlayRisky
         [{-no results-}]
-        (CmmPrim MO_Memset)
+        (CmmPrim MO_Memset Nothing)
         [ (CmmHinted dst AddrHint)
         , (CmmHinted c NoHint)
         , (CmmHinted n NoHint)
@@ -956,7 +1130,7 @@ emitPopCntCall res x width live = do
     vols <- getVolatileRegs live
     emitForeignCall' PlayRisky
         [CmmHinted res NoHint]
-        (CmmPrim (MO_PopCnt width))
+        (CmmPrim (MO_PopCnt width) Nothing)
         [(CmmHinted x NoHint)]
         (Just vols)
         NoC_SRT -- No SRT b/c we do PlayRisky
diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs
index 296dd62818..1a5f916dbe 100644
--- a/compiler/codeGen/CgProf.hs
+++ b/compiler/codeGen/CgProf.hs
@@ -170,8 +170,9 @@ emitCostCentreDecl cc = do
                 -- All cost centres will be in the main package, since we
                 -- don't normally use -auto-all or add SCCs to other packages.
                 -- Hence don't emit the package name in the module here.
+  ; dflags <- getDynFlags
   ; loc <- newByteStringCLit $ bytesFS $ mkFastString $
-                   showSDoc (ppr (costCentreSrcSpan cc))
+                   showPpr dflags (costCentreSrcSpan cc)
            -- XXX going via FastString to get UTF-8 encoding is silly
   ; let
      lits = [ zero,   	-- StgInt ccID,
diff --git a/compiler/codeGen/CgStackery.lhs b/compiler/codeGen/CgStackery.lhs
index 2628760183..a869795caa 100644
--- a/compiler/codeGen/CgStackery.lhs
+++ b/compiler/codeGen/CgStackery.lhs
@@ -43,6 +43,7 @@ import OrdList
 import Outputable
 
 import Control.Monad
+import Data.List
 \end{code}
 
 %************************************************************************
@@ -333,7 +334,7 @@ Explicitly free some stack space.
 freeStackSlots :: [VirtualSpOffset] -> Code
 freeStackSlots extra_free
   = do	{ stk_usg <- getStkUsage
-	; let all_free = addFreeSlots (freeStk stk_usg) (sortLe (<=) extra_free)
+	; let all_free = addFreeSlots (freeStk stk_usg) (sort extra_free)
 	; let (new_vsp, new_free) = trim (virtSp stk_usg) all_free
 	; setStkUsage (stk_usg { virtSp = new_vsp, freeStk = new_free }) }
 
diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs
index 499529d841..e933fedb5b 100644
--- a/compiler/codeGen/CgTailCall.lhs
+++ b/compiler/codeGen/CgTailCall.lhs
@@ -43,6 +43,7 @@ import StgSyn
 import PrimOp
 import Outputable
 import StaticFlags
+import Util
 
 import Control.Monad
 import Data.Maybe
diff --git a/compiler/codeGen/CgTicky.hs b/compiler/codeGen/CgTicky.hs
index 0ff440e6bf..021b0e4fd9 100644
--- a/compiler/codeGen/CgTicky.hs
+++ b/compiler/codeGen/CgTicky.hs
@@ -91,7 +91,8 @@ emitTickyCounter :: ClosureInfo -> [Id] -> Int -> Code
 emitTickyCounter cl_info args on_stk
   = ifTicky $
     do	{ mod_name <- getModuleName
-	; fun_descr_lit <- newStringCLit (fun_descr mod_name)
+	; dflags <- getDynFlags
+	; fun_descr_lit <- newStringCLit (fun_descr dflags mod_name)
 	; arg_descr_lit <- newStringCLit arg_descr
 	; emitDataLits ticky_ctr_label 	-- Must match layout of StgEntCounter
 -- krc: note that all the fields are I32 now; some were I16 before, 
@@ -110,15 +111,15 @@ emitTickyCounter cl_info args on_stk
     name = closureName cl_info
     ticky_ctr_label = mkRednCountsLabel name NoCafRefs
     arg_descr = map (showTypeCategory . idType) args
-    fun_descr mod_name = ppr_for_ticky_name mod_name name
+    fun_descr dflags mod_name = ppr_for_ticky_name dflags mod_name name
 
 -- When printing the name of a thing in a ticky file, we want to
 -- give the module name even for *local* things.   We print
 -- just "x (M)" rather that "M.x" to distinguish them from the global kind.
-ppr_for_ticky_name :: Module -> Name -> String
-ppr_for_ticky_name mod_name name
-  | isInternalName name = showSDocDebug (ppr name <+> (parens (ppr mod_name)))
-  | otherwise	        = showSDocDebug (ppr name)
+ppr_for_ticky_name :: DynFlags -> Module -> Name -> String
+ppr_for_ticky_name dflags mod_name name
+  | isInternalName name = showSDocDebug dflags (ppr name <+> (parens (ppr mod_name)))
+  | otherwise           = showSDocDebug dflags (ppr name)
 
 -- -----------------------------------------------------------------------------
 -- Ticky stack frames
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 2bd35c8796..e7d17c1f03 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -72,7 +72,9 @@ import Outputable
 
 import Data.Char
 import Data.Word
+import Data.List
 import Data.Maybe
+import Data.Ord
 
 -------------------------------------------------------------------------
 --
@@ -527,12 +529,10 @@ emitSwitch tag_expr branches mb_deflt lo_tag hi_tag
         ; let via_C | HscC <- hscTarget dflags = True
                     | otherwise                = False
 
-        ; stmts <- mk_switch tag_expr (sortLe le branches)
+        ; stmts <- mk_switch tag_expr (sortBy (comparing fst) branches)
                         mb_deflt_id lo_tag hi_tag via_C
         ; emitCgStmts stmts
         }
-  where
-    (t1,_) `le` (t2,_) = t1 <= t2
 
 
 mk_switch :: CmmExpr -> [(ConTagZ, CgStmts)]
@@ -699,10 +699,8 @@ emitLitSwitch _     []       deflt = emitCgStmts deflt
 emitLitSwitch scrut branches deflt_blk
   = do  { scrut' <- assignTemp scrut
         ; deflt_blk_id <- forkCgStmts deflt_blk
-        ; blk <- mk_lit_switch scrut' deflt_blk_id (sortLe le branches)
+        ; blk <- mk_lit_switch scrut' deflt_blk_id (sortBy (comparing fst) branches)
         ; emitCgStmts blk }
-  where
-    le (t1,_) (t2,_) = t1 <= t2
 
 mk_lit_switch :: CmmExpr -> BlockId
               -> [(Literal,CgStmts)]
@@ -1011,7 +1009,8 @@ fixStgRegStmt stmt
         CmmCall target regs args returns ->
             let target' = case target of
                     CmmCallee e conv -> CmmCallee (fixStgRegExpr e) conv
-                    other            -> other
+                    CmmPrim op mStmts ->
+                        CmmPrim op (fmap (map fixStgRegStmt) mStmts)
                 args' = map (\(CmmHinted arg hint) ->
                                 (CmmHinted (fixStgRegExpr arg) hint)) args
             in CmmCall target' regs args' returns
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index 34746984c2..7a91a5e2a1 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -20,6 +20,8 @@ the STG paper.
 -- for details
 
 module ClosureInfo (
+        idRepArity,
+
 	ClosureInfo(..), LambdaFormInfo(..),	-- would be abstract but
 	StandardFormInfo(..),			-- mkCmmInfo looks inside
         SMRep,
@@ -96,6 +98,7 @@ import Outputable
 import FastString
 import Constants
 import DynFlags
+import Util
 \end{code}
 
 
@@ -156,7 +159,7 @@ ClosureInfo contains a LambdaFormInfo.
 data LambdaFormInfo
   = LFReEntrant		-- Reentrant closure (a function)
 	TopLevelFlag	-- True if top level
-	!Int		-- Arity. Invariant: always > 0
+	!RepArity	-- Arity. Invariant: always > 0
 	!Bool		-- True <=> no fvs
 	ArgDescr	-- Argument descriptor (should reall be in ClosureInfo)
 
@@ -180,7 +183,7 @@ data LambdaFormInfo
 
   | LFLetNoEscape	-- See LetNoEscape module for precise description of
 			-- these "lets".
-	!Int		-- arity;
+	!RepArity	-- arity;
 
   | LFBlackHole		-- Used for the closures allocated to hold the result
 			-- of a CAF.  We want the target of the update frame to
@@ -211,7 +214,7 @@ data StandardFormInfo
 	-- The code for the thunk just pushes x2..xn on the stack and enters x1.
 	-- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
 	-- in the RTS to save space.
-	Int		-- Arity, n
+	RepArity	-- Arity, n
 \end{code}
 
 
@@ -288,7 +291,7 @@ idCgRep x = typeCgRep . idType $ x
 tyConCgRep :: TyCon -> CgRep
 tyConCgRep = primRepToCgRep . tyConPrimRep
 
-typeCgRep :: Type -> CgRep
+typeCgRep :: UnaryType -> CgRep
 typeCgRep = primRepToCgRep . typePrimRep 
 \end{code}
 
@@ -384,9 +387,12 @@ might_be_a_function :: Type -> Bool
 -- Return False only if we are *sure* it's a data type
 -- Look through newtypes etc as much as poss
 might_be_a_function ty
-  = case tyConAppTyCon_maybe (repType ty) of
-	Just tc -> not (isDataTyCon tc)
-	Nothing -> True
+  | UnaryRep rep <- repType ty
+  , Just tc <- tyConAppTyCon_maybe rep
+  , isDataTyCon tc
+  = False
+  | otherwise
+  = True
 \end{code}
 
 @mkConLFInfo@ is similar, for constructors.
@@ -404,7 +410,7 @@ mkSelectorLFInfo id offset updatable
   = LFThunk NotTopLevel False updatable (SelectorThunk offset) 
 	(might_be_a_function (idType id))
 
-mkApLFInfo :: Id -> UpdateFlag -> Int -> LambdaFormInfo
+mkApLFInfo :: Id -> UpdateFlag -> RepArity -> LambdaFormInfo
 mkApLFInfo id upd_flag arity
   = LFThunk NotTopLevel (arity == 0) (isUpdatable upd_flag) (ApThunk arity)
 	(might_be_a_function (idType id))
@@ -416,12 +422,12 @@ Miscellaneous LF-infos.
 mkLFArgument :: Id -> LambdaFormInfo
 mkLFArgument id = LFUnknown (might_be_a_function (idType id))
 
-mkLFLetNoEscape :: Int -> LambdaFormInfo
+mkLFLetNoEscape :: RepArity -> LambdaFormInfo
 mkLFLetNoEscape = LFLetNoEscape
 
 mkLFImported :: Id -> LambdaFormInfo
 mkLFImported id
-  = case idArity id of
+  = case idRepArity id of
       n | n > 0 -> LFReEntrant TopLevel n True (panic "arg_descr")  -- n > 0
       _ -> mkLFArgument id -- Not sure of exact arity
 \end{code}
@@ -634,17 +640,17 @@ data CallMethod
 
   | DirectEntry 			-- Jump directly, with args in regs
 	CLabel 				--   The code label
-	Int 				--   Its arity
+	RepArity			--   Its arity
 
 getCallMethod :: DynFlags
               -> Name		-- Function being applied
               -> CafInfo        -- Can it refer to CAF's?
 	      -> LambdaFormInfo	-- Its info
-	      -> Int		-- Number of available arguments
+	      -> RepArity	-- Number of available arguments
 	      -> CallMethod
 
-getCallMethod _ _ _ lf_info _
-  | nodeMustPointToIt lf_info && opt_Parallel
+getCallMethod dflags _ _ lf_info _
+  | nodeMustPointToIt lf_info && dopt Opt_Parallel dflags
   =	-- If we're parallel, then we must always enter via node.  
 	-- The reason is that the closure may have been 	
 	-- fetched since we allocated it.
@@ -725,7 +731,7 @@ blackHoleOnEntry cl_info
   = case closureLFInfo cl_info of
 	LFReEntrant _ _ _ _	  -> False
         LFLetNoEscape _           -> False
-        LFThunk _ no_fvs _updatable _ _ -> not no_fvs -- to plug space-leaks.
+        LFThunk _ _no_fvs _updatable _ _ -> True
         _other -> panic "blackHoleOnEntry"      -- Should never happen
 
 isKnownFun :: LambdaFormInfo -> Bool
@@ -911,11 +917,11 @@ isConstrClosure_maybe :: ClosureInfo -> Maybe DataCon
 isConstrClosure_maybe (ConInfo { closureCon = data_con }) = Just data_con
 isConstrClosure_maybe _ 				  = Nothing
 
-closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
+closureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr)
 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
 closureFunInfo _ = Nothing
 
-lfFunInfo :: LambdaFormInfo ->  Maybe (Int, ArgDescr)
+lfFunInfo :: LambdaFormInfo ->  Maybe (RepArity, ArgDescr)
 lfFunInfo (LFReEntrant _ arity _ arg_desc)  = Just (arity, arg_desc)
 lfFunInfo _                                 = Nothing
 
@@ -935,7 +941,7 @@ funTagLFInfo lf
   | otherwise
   = 0
 
-tagForArity :: Int -> Maybe Int
+tagForArity :: RepArity -> Maybe Int
 tagForArity i | i <= mAX_PTR_TAG = Just i
               | otherwise        = Nothing
 
@@ -1097,8 +1103,16 @@ getTyDescription ty
       FunTy _ res      	     -> '-' : '>' : fun_result res
       TyConApp tycon _ 	     -> getOccString tycon
       ForAllTy _ ty          -> getTyDescription ty
+      LitTy n                -> getTyLitDescription n
     }
   where
     fun_result (FunTy _ res) = '>' : fun_result res
     fun_result other	     = getTyDescription other
+
+
+getTyLitDescription :: TyLit -> String
+getTyLitDescription l =
+  case l of
+    NumTyLit n -> show n
+    StrTyLit n -> show n
 \end{code}
diff --git a/compiler/codeGen/CodeGen.lhs b/compiler/codeGen/CodeGen.lhs
index f8898450ef..9c936d3281 100644
--- a/compiler/codeGen/CodeGen.lhs
+++ b/compiler/codeGen/CodeGen.lhs
@@ -75,8 +75,7 @@ codeGen dflags this_mod data_tycons cost_centre_info stg_binds hpc_info
                          st <- readIORef cgref
                          let (a,st') = runC dflags this_mod st fcode
 
-                         dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" $
-                             pprPlatform (targetPlatform dflags) a
+                         dumpIfSet_dyn dflags Opt_D_dump_cmm "Cmm" $ ppr a
 
                          -- NB. stub-out cgs_tops and cgs_stmts.  This fixes
                          -- a big space leak.  DO NOT REMOVE!
diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs
index 933aeb9d45..696af8107e 100644
--- a/compiler/codeGen/StgCmm.hs
+++ b/compiler/codeGen/StgCmm.hs
@@ -53,6 +53,7 @@ import MkGraph
 
 import Data.IORef
 import Control.Monad (when)
+import Util
 
 codeGen :: DynFlags
 	 -> Module
@@ -246,8 +247,8 @@ cgDataCon data_con
 					    (tagForCon data_con)] }
                         -- The case continuation code expects a tagged pointer
 
-	    arg_reps :: [(PrimRep, Type)]
-	    arg_reps = [(typePrimRep ty, ty) | ty <- dataConRepArgTys data_con]
+	    arg_reps :: [(PrimRep, UnaryType)]
+	    arg_reps = [(typePrimRep rep_ty, rep_ty) | ty <- dataConRepArgTys data_con, rep_ty <- flattenRepType (repType ty)]
 
 	    -- Dynamic closure code for non-nullary constructors only
 	; whenC (not (isNullaryRepDataCon data_con))
diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs
index 5838628fca..f98283f737 100644
--- a/compiler/codeGen/StgCmmBind.hs
+++ b/compiler/codeGen/StgCmmBind.hs
@@ -79,9 +79,10 @@ cgTopRhsClosure id ccs _ upd_flag srt args body = do
   ; lf_info <- mkClosureLFInfo id TopLevel [] upd_flag args
   ; has_srt <- getSRTInfo srt
   ; mod_name <- getModuleName
-  ; let descr         = closureDescription mod_name name
+  ; dflags   <- getDynFlags
+  ; let descr         = closureDescription dflags mod_name name
         closure_info  = mkClosureInfo True id lf_info 0 0 descr
-	closure_label = mkLocalClosureLabel name (idCafInfo id)
+        closure_label = mkLocalClosureLabel name (idCafInfo id)
     	cg_id_info    = litIdInfo id lf_info (CmmLabel closure_label)
         caffy         = idCafInfo id
         info_tbl      = mkCmmInfo closure_info -- XXX short-cut
@@ -285,9 +286,10 @@ mkRhsClosure bndr cc _ fvs upd_flag args body
 	-- MAKE CLOSURE INFO FOR THIS CLOSURE
 	; lf_info <- mkClosureLFInfo bndr NotTopLevel fvs upd_flag args
 	; mod_name <- getModuleName
+        ; dflags <- getDynFlags
         ; let   name  = idName bndr
-		descr = closureDescription mod_name name
-		fv_details :: [(NonVoid Id, VirtualHpOffset)]
+                descr = closureDescription dflags mod_name name
+                fv_details :: [(NonVoid Id, VirtualHpOffset)]
 		(tot_wds, ptr_wds, fv_details)
 		   = mkVirtHeapOffsets (isLFThunk lf_info)
 				       (addIdReps (map stripNV reduced_fvs))
@@ -333,10 +335,11 @@ cgStdThunk bndr _cc _bndr_info _body lf_info payload
   = do	-- AHA!  A STANDARD-FORM THUNK
   {	-- LAY OUT THE OBJECT
     mod_name <- getModuleName
+  ; dflags <- getDynFlags
   ; let (tot_wds, ptr_wds, payload_w_offsets)
 	    = mkVirtHeapOffsets (isLFThunk lf_info) (addArgReps payload)
 
-	descr = closureDescription mod_name (idName bndr)
+	descr = closureDescription dflags mod_name (idName bndr)
 	closure_info = mkClosureInfo False 	-- Not static
 				     bndr lf_info tot_wds ptr_wds
                                      descr
@@ -404,9 +407,7 @@ closureCodeBody top_lvl bndr cl_info _cc args arity body fv_details
     do  { -- Allocate the global ticky counter,
           -- and establish the ticky-counter
           -- label for this block
-        ; dflags <- getDynFlags
-        ; let platform = targetPlatform dflags
-              ticky_ctr_lbl = closureRednCountsLabel platform cl_info
+          let ticky_ctr_lbl = closureRednCountsLabel cl_info
         ; emitTickyCounter cl_info (map stripNV args)
         ; setTickyCtrLabel ticky_ctr_lbl $ do
 
@@ -463,10 +464,8 @@ mkSlowEntryCode :: ClosureInfo -> [LocalReg] -> FCode ()
 mkSlowEntryCode _ [] = panic "entering a closure with no arguments?"
 mkSlowEntryCode cl_info arg_regs -- function closure is already in `Node'
   | Just (_, ArgGen _) <- closureFunInfo cl_info
-  = do dflags <- getDynFlags
-       let platform = targetPlatform dflags
-           slow_lbl = closureSlowEntryLabel  platform cl_info
-           fast_lbl = closureLocalEntryLabel platform cl_info
+  = do let slow_lbl = closureSlowEntryLabel  cl_info
+           fast_lbl = closureLocalEntryLabel cl_info
            -- mkDirectJump does not clobber `Node' containing function closure
            jump = mkDirectJump (mkLblExpr fast_lbl)
                                (map (CmmReg . CmmLocal) arg_regs)
@@ -561,12 +560,15 @@ setupUpdate closure_info node body
       then do tickyUpdateFrameOmitted; body
       else do
           tickyPushUpdateFrame
-          --dflags <- getDynFlags
-          let es = [CmmReg (CmmLocal node), mkLblExpr mkUpdInfoLabel]
-          --if not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags
-          --  then pushUpdateFrame es body -- XXX black hole
-          --  else pushUpdateFrame es body
-          pushUpdateFrame es body
+          dflags <- getDynFlags
+          let
+              bh = blackHoleOnEntry closure_info &&
+                   not opt_SccProfilingOn && dopt Opt_EagerBlackHoling dflags
+
+              lbl | bh        = mkBHUpdInfoLabel
+                  | otherwise = mkUpdInfoLabel
+
+          pushUpdateFrame [CmmReg (CmmLocal node), mkLblExpr lbl] body
 
   | otherwise	-- A static closure
   = do 	{ tickyUpdateBhCaf closure_info
@@ -575,7 +577,7 @@ setupUpdate closure_info node body
 	  then do	-- Blackhole the (updatable) CAF:
                 { upd_closure <- link_caf True
 		; pushUpdateFrame [CmmReg (CmmLocal upd_closure),
-                                     mkLblExpr mkUpdInfoLabel] body } -- XXX black hole
+                                   mkLblExpr mkBHUpdInfoLabel] body }
 	  else do {tickyUpdateFrameOmitted; body}
     }
 
@@ -679,13 +681,14 @@ link_caf _is_upd = do
 -- name of the data constructor itself.  Otherwise it is determined by
 -- @closureDescription@ from the let binding information.
 
-closureDescription :: Module		-- Module
+closureDescription :: DynFlags
+           -> Module		-- Module
 		   -> Name		-- Id of closure binding
 		   -> String
 	-- Not called for StgRhsCon which have global info tables built in
 	-- CgConTbls.lhs with a description generated from the data constructor
-closureDescription mod_name name
-  = showSDocDump (char '<' <>
+closureDescription dflags mod_name name
+  = showSDocDump dflags (char '<' <>
 		    (if isExternalName name
 		      then ppr name -- ppr will include the module name prefix
 		      else pprModule mod_name <> char '.' <> ppr name) <>
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 487c94daaa..8023abddec 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -21,8 +21,8 @@ module StgCmmClosure (
         DynTag,  tagForCon, isSmallFamily,
 	ConTagZ, dataConTagZ,
 
-        isVoidRep, isGcPtrRep, addIdReps, addArgReps,
-	argPrimRep, 
+        idPrimRep, isVoidRep, isGcPtrRep, addIdReps, addArgReps,
+	argPrimRep,
 
         -- * LambdaFormInfo
         LambdaFormInfo,         -- Abstract
@@ -87,9 +87,9 @@ import TcType
 import TyCon
 import BasicTypes
 import Outputable
-import Platform
 import Constants
 import DynFlags
+import Util
 
 -----------------------------------------------------------------------------
 --		Representations
@@ -97,6 +97,10 @@ import DynFlags
 
 -- Why are these here?
 
+-- NB: this is reliable because by StgCmm no Ids have unboxed tuple type
+idPrimRep :: Id -> PrimRep
+idPrimRep id = typePrimRep (idType id)
+
 addIdReps :: [Id] -> [(PrimRep, Id)]
 addIdReps ids = [(idPrimRep id, id) | id <- ids]
 
@@ -127,7 +131,7 @@ isGcPtrRep _      = False
 data LambdaFormInfo
   = LFReEntrant		-- Reentrant closure (a function)
 	TopLevelFlag	-- True if top level
-	!Int		-- Arity. Invariant: always > 0
+	!RepArity		-- Arity. Invariant: always > 0
 	!Bool		-- True <=> no fvs
 	ArgDescr	-- Argument descriptor (should really be in ClosureInfo)
 
@@ -188,7 +192,7 @@ data StandardFormInfo
 	-- The code for the thunk just pushes x2..xn on the stack and enters x1.
 	-- There are a few of these (for 1 <= n <= MAX_SPEC_AP_SIZE) pre-compiled
 	-- in the RTS to save space.
-	Int		-- Arity, n
+	RepArity		-- Arity, n
 
 
 ------------------------------------------------------
@@ -231,9 +235,12 @@ might_be_a_function :: Type -> Bool
 -- Return False only if we are *sure* it's a data type
 -- Look through newtypes etc as much as poss
 might_be_a_function ty
-  = case tyConAppTyCon_maybe (repType ty) of
-	Just tc -> not (isDataTyCon tc)
-	Nothing -> True
+  | UnaryRep rep <- repType ty
+  , Just tc <- tyConAppTyCon_maybe rep
+  , isDataTyCon tc
+  = False
+  | otherwise
+  = True
 
 -------------
 mkConLFInfo :: DataCon -> LambdaFormInfo
@@ -266,7 +273,7 @@ mkLFImported id
   | otherwise
   = mkLFArgument id -- Not sure of exact arity
   where
-    arity = idArity id
+    arity = idRepArity id
 
 ------------
 mkLFBlackHole :: LambdaFormInfo
@@ -309,7 +316,7 @@ tagForCon con
     con_tag  = dataConTagZ con
     fam_size = tyConFamilySize (dataConTyCon con)
 
-tagForArity :: Int -> DynTag
+tagForArity :: RepArity -> DynTag
 tagForArity arity | isSmallFamily arity = arity
                   | otherwise           = 0
 
@@ -458,17 +465,17 @@ data CallMethod
 
   | DirectEntry 	-- Jump directly, with args in regs
 	CLabel 		--   The code label
-	Int 		--   Its arity
+	RepArity 		--   Its arity
 
 getCallMethod :: DynFlags
               -> Name           -- Function being applied
               -> CafInfo        -- Can it refer to CAF's?
 	      -> LambdaFormInfo	-- Its info
-	      -> Int		-- Number of available arguments
+	      -> RepArity		-- Number of available arguments
 	      -> CallMethod
 
-getCallMethod _ _name _ lf_info _n_args
-  | nodeMustPointToIt lf_info && opt_Parallel
+getCallMethod dflags _name _ lf_info _n_args
+  | nodeMustPointToIt lf_info && dopt Opt_Parallel dflags
   =	-- If we're parallel, then we must always enter via node.  
 	-- The reason is that the closure may have been 	
 	-- fetched since we allocated it.
@@ -717,7 +724,7 @@ blackHoleOnEntry cl_info
   = case closureLFInfo cl_info of
 	LFReEntrant _ _ _ _	  -> False
 	LFLetNoEscape 		  -> False
-        LFThunk _ no_fvs _updatable _ _ -> not no_fvs -- to plug space-leaks.
+        LFThunk _ _no_fvs _updatable _ _ -> True
         _other -> panic "blackHoleOnEntry"      -- Should never happen
 
 isStaticClosure :: ClosureInfo -> Bool
@@ -741,10 +748,10 @@ closureReEntrant :: ClosureInfo -> Bool
 closureReEntrant (ClosureInfo { closureLFInfo = LFReEntrant _ _ _ _ }) = True
 closureReEntrant _ = False
 
-closureFunInfo :: ClosureInfo -> Maybe (Int, ArgDescr)
+closureFunInfo :: ClosureInfo -> Maybe (RepArity, ArgDescr)
 closureFunInfo (ClosureInfo { closureLFInfo = lf_info }) = lfFunInfo lf_info
 
-lfFunInfo :: LambdaFormInfo ->  Maybe (Int, ArgDescr)
+lfFunInfo :: LambdaFormInfo ->  Maybe (RepArity, ArgDescr)
 lfFunInfo (LFReEntrant _ arity _ arg_desc)  = Just (arity, arg_desc)
 lfFunInfo _                                 = Nothing
 
@@ -762,19 +769,19 @@ isToplevClosure (ClosureInfo { closureLFInfo = lf_info })
 --   Label generation
 --------------------------------------
 
-staticClosureLabel :: Platform -> ClosureInfo -> CLabel
-staticClosureLabel platform = toClosureLbl platform .  closureInfoLabel
+staticClosureLabel :: ClosureInfo -> CLabel
+staticClosureLabel = toClosureLbl .  closureInfoLabel
 
-closureRednCountsLabel :: Platform -> ClosureInfo -> CLabel
-closureRednCountsLabel platform = toRednCountsLbl platform . closureInfoLabel
+closureRednCountsLabel :: ClosureInfo -> CLabel
+closureRednCountsLabel = toRednCountsLbl . closureInfoLabel
 
-closureSlowEntryLabel :: Platform -> ClosureInfo -> CLabel
-closureSlowEntryLabel platform = toSlowEntryLbl platform . closureInfoLabel
+closureSlowEntryLabel :: ClosureInfo -> CLabel
+closureSlowEntryLabel = toSlowEntryLbl . closureInfoLabel
 
-closureLocalEntryLabel :: Platform -> ClosureInfo -> CLabel
-closureLocalEntryLabel platform
-  | tablesNextToCode = toInfoLbl  platform . closureInfoLabel
-  | otherwise        = toEntryLbl platform . closureInfoLabel
+closureLocalEntryLabel :: ClosureInfo -> CLabel
+closureLocalEntryLabel
+  | tablesNextToCode = toInfoLbl  . closureInfoLabel
+  | otherwise        = toEntryLbl . closureInfoLabel
 
 mkClosureInfoTableLabel :: Id -> LambdaFormInfo -> CLabel
 mkClosureInfoTableLabel id lf_info
@@ -861,11 +868,18 @@ getTyDescription ty
       FunTy _ res      	     -> '-' : '>' : fun_result res
       TyConApp tycon _ 	     -> getOccString tycon
       ForAllTy _ ty          -> getTyDescription ty
+      LitTy n                -> getTyLitDescription n
     }
   where
     fun_result (FunTy _ res) = '>' : fun_result res
     fun_result other	     = getTyDescription other
 
+getTyLitDescription :: TyLit -> String
+getTyLitDescription l =
+  case l of
+    NumTyLit n -> show n
+    StrTyLit n -> show n
+
 --------------------------------------
 --   CmmInfoTable-related things
 --------------------------------------
diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index 1a40a4273f..c348570a54 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -41,7 +41,7 @@ import PrelInfo
 import Outputable
 import Platform
 import StaticFlags
-import Util             ( lengthIs )
+import Util
 
 import Control.Monad
 import Data.Char
@@ -62,7 +62,7 @@ cgTopRhsCon id con args
         ; when (platformOS (targetPlatform dflags) == OSMinGW32) $
               -- Windows DLLs have a problem with static cross-DLL refs.
               ASSERT( not (isDllConApp dflags con args) ) return ()
-        ; ASSERT( args `lengthIs` dataConRepArity con ) return ()
+        ; ASSERT( args `lengthIs` dataConRepRepArity con ) return ()
 
         -- LAY IT OUT
         ; let
diff --git a/compiler/codeGen/StgCmmEnv.hs b/compiler/codeGen/StgCmmEnv.hs
index 3b56e2feb6..2edd09da12 100644
--- a/compiler/codeGen/StgCmmEnv.hs
+++ b/compiler/codeGen/StgCmmEnv.hs
@@ -201,7 +201,6 @@ getArgAmode :: NonVoid StgArg -> FCode CmmExpr
 getArgAmode (NonVoid (StgVarArg var))  =
   do { info  <- getCgIdInfo var; return (idInfoToAmode info) }
 getArgAmode (NonVoid (StgLitArg lit))  = liftM CmmLit $ cgLit lit
-getArgAmode (NonVoid (StgTypeArg _))   = panic "getArgAmode: type arg"
 
 getNonVoidArgAmodes :: [StgArg] -> FCode [CmmExpr]
 -- NB: Filters out void args, 
diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs
index e682af0ced..4db1dffdfc 100644
--- a/compiler/codeGen/StgCmmExpr.hs
+++ b/compiler/codeGen/StgCmmExpr.hs
@@ -590,7 +590,7 @@ cgConApp con stg_args
        ; emitReturn arg_exprs }
 
   | otherwise	--  Boxed constructors; allocate and return
-  = ASSERT( stg_args `lengthIs` dataConRepArity con )
+  = ASSERT( stg_args `lengthIs` dataConRepRepArity con )
     do	{ (idinfo, init) <- buildDynCon (dataConWorkId con) currentCCS con stg_args
 	   	-- The first "con" says that the name bound to this closure is
 		-- is "con", which is a bit of a fudge, but it only affects profiling
diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs
index d5c9600b38..c67e0e0c95 100644
--- a/compiler/codeGen/StgCmmForeign.hs
+++ b/compiler/codeGen/StgCmmForeign.hs
@@ -58,7 +58,9 @@ cgForeignCall (CCall (CCallSpec target cconv safety)) stg_args res_ty
         ; (res_regs, res_hints) <- newUnboxedTupleRegs res_ty
         ; let ((call_args, arg_hints), cmm_target)
                 = case target of
-                   StaticTarget lbl mPkgId
+                   StaticTarget _   _      False ->
+                       panic "cgForeignCall: unexpected FFI value import"
+                   StaticTarget lbl mPkgId True
                      -> let labelSource
                                 = case mPkgId of
                                         Nothing         -> ForeignLabelInThisPackage
@@ -390,5 +392,6 @@ add_shim arg_ty expr
 
   | otherwise = expr
   where
-    tycon = tyConAppTyCon (repType arg_ty)
+    UnaryRep rep_ty = repType arg_ty
+    tycon           = tyConAppTyCon rep_ty
         -- should be a tycon app, since this is a foreign call
diff --git a/compiler/codeGen/StgCmmGran.hs b/compiler/codeGen/StgCmmGran.hs
index 232c7c6b58..2abca3fe16 100644
--- a/compiler/codeGen/StgCmmGran.hs
+++ b/compiler/codeGen/StgCmmGran.hs
@@ -3,22 +3,15 @@
 -- (c) The University of Glasgow -2006
 --
 -- Code generation relaed to GpH
--- 	(a) parallel
---	(b) GranSim
+--      (a) parallel
+--      (b) GranSim
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
 module StgCmmGran (
-	staticGranHdr,staticParHdr,
-	granThunk, granYield,
-	doGranAllocate
+        staticGranHdr,staticParHdr,
+        granThunk, granYield,
+        doGranAllocate
   ) where
 
 -- This entire module consists of no-op stubs at the moment
@@ -57,11 +50,11 @@ staticGranHdr :: [CmmLit]
 -- Gransim header words in a static closure
 staticGranHdr = []
 
-doGranAllocate :: CmmExpr -> Code	
+doGranAllocate :: CmmExpr -> Code
 -- macro DO_GRAN_ALLOCATE
-doGranAllocate hp 
+doGranAllocate hp
   | not opt_GranMacros = nopC
-  | otherwise	       = panic "doGranAllocate"
+  | otherwise          = panic "doGranAllocate"
 
 
 
@@ -69,13 +62,13 @@ doGranAllocate hp
 granThunk :: Bool -> FCode ()
 -- HWL: insert macros for GrAnSim; 2 versions depending on liveness of node
 -- (we prefer fetchAndReschedule-style context switches to yield ones)
-granThunk node_points 
-  | node_points = granFetchAndReschedule [] node_points 
-  | otherwise   = granYield 	         [] node_points
+granThunk node_points
+  | node_points = granFetchAndReschedule [] node_points
+  | otherwise   = granYield              [] node_points
 
 granFetchAndReschedule :: [(Id,GlobalReg)]  -- Live registers
-		       -> Bool           	-- Node reqd?
-		       -> Code
+                       -> Bool                  -- Node reqd?
+                       -> Code
 -- Emit code for simulating a fetch and then reschedule.
 granFetchAndReschedule regs node_reqd
   | opt_GranMacros && (node `elem` map snd regs || node_reqd)
@@ -87,15 +80,15 @@ granFetchAndReschedule regs node_reqd
     liveness = mkRegLiveness regs 0 0
 
 fetch = panic "granFetch"
-	-- Was: absC (CMacroStmt GRAN_FETCH [])
-	--HWL: generate GRAN_FETCH macro for GrAnSim
- 	--     currently GRAN_FETCH and GRAN_FETCH_AND_RESCHEDULE are miai
+        -- Was: absC (CMacroStmt GRAN_FETCH [])
+        --HWL: generate GRAN_FETCH macro for GrAnSim
+        --     currently GRAN_FETCH and GRAN_FETCH_AND_RESCHEDULE are miai
 
 reschedule liveness node_reqd = panic "granReschedule"
-	-- Was: absC  (CMacroStmt GRAN_RESCHEDULE [
-  	--                mkIntCLit (I# (word2Int# liveness_mask)), 
-    	--		  mkIntCLit (if node_reqd then 1 else 0)])
-    
+        -- Was: absC  (CMacroStmt GRAN_RESCHEDULE [
+        --                mkIntCLit (I# (word2Int# liveness_mask)),
+        --                mkIntCLit (if node_reqd then 1 else 0)])
+
 
 -------------------------
 -- The @GRAN_YIELD@ macro is taken from JSM's  code for Concurrent Haskell. It
@@ -103,25 +96,25 @@ reschedule liveness node_reqd = panic "granReschedule"
 -- @Continue@ rather  than the @EnterNodeCode@  function in the  RTS). We emit
 -- this kind of macro at the beginning of the following kinds of basic bocks:
 -- \begin{itemize}
---  \item Slow entry code where node is not alive (see @CgClosure.lhs@). Normally 
+--  \item Slow entry code where node is not alive (see @CgClosure.lhs@). Normally
 --        we use @fetchAndReschedule@ at a slow entry code.
 --  \item Fast entry code (see @CgClosure.lhs@).
 --  \item Alternatives in case expressions (@CLabelledCode@ structures), provided
---        that they are not inlined (see @CgCases.lhs@). These alternatives will 
+--        that they are not inlined (see @CgCases.lhs@). These alternatives will
 --        be turned into separate functions.
 
 granYield :: [(Id,GlobalReg)]   -- Live registers
           -> Bool               -- Node reqd?
-          -> Code 
+          -> Code
 
 granYield regs node_reqd
   | opt_GranMacros && node_reqd = yield liveness
-  | otherwise			= nopC
+  | otherwise                   = nopC
   where
      liveness = mkRegLiveness regs 0 0
 
 yield liveness = panic "granYield"
-	-- Was : absC (CMacroStmt GRAN_YIELD 
+        -- Was : absC (CMacroStmt GRAN_YIELD
         --                  [mkIntCLit (I# (word2Int# liveness_mask))])
 
 -}
diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs
index 37dc467862..856b04367d 100644
--- a/compiler/codeGen/StgCmmHeap.hs
+++ b/compiler/codeGen/StgCmmHeap.hs
@@ -43,7 +43,7 @@ import IdInfo( CafInfo(..), mayHaveCafRefs )
 import Module
 import FastString( mkFastString, fsLit )
 import Constants
-import DynFlags
+import Util
 
 -----------------------------------------------------------
 --              Initialise dynamic heap objects
@@ -331,11 +331,7 @@ entryHeapCheck :: ClosureInfo
                -> FCode ()
 
 entryHeapCheck cl_info offset nodeSet arity args code
-  = do dflags <- getDynFlags
-
-       let platform = targetPlatform dflags
-
-           is_thunk = arity == 0
+  = do let is_thunk = arity == 0
            is_fastf = case closureFunInfo cl_info of
                            Just (_, ArgGen _) -> False
                            _otherwise         -> True
@@ -345,7 +341,7 @@ entryHeapCheck cl_info offset nodeSet arity args code
                           Just n  -> mkNop -- No need to assign R1, it already
                                            -- points to the closure
                           Nothing -> mkAssign nodeReg $
-                              CmmLit (CmmLabel $ staticClosureLabel platform cl_info)
+                              CmmLit (CmmLabel $ staticClosureLabel cl_info)
 
            {- Thunks:          jump GCEnter1
               Function (fast): Set R1 = node, jump GCFun
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 16b33d1faf..9593af1f50 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -52,8 +52,7 @@ import StgSyn
 import Id
 import Name
 import TyCon		( PrimRep(..) )
-import BasicTypes	( Arity )
-import DynFlags
+import BasicTypes	( RepArity )
 import StaticFlags
 import Module
 
@@ -61,7 +60,7 @@ import Constants
 import Util
 import Data.List
 import Outputable
-import FastString	( mkFastString, FastString, fsLit )
+import FastString
 
 ------------------------------------------------------------------------
 --		Call and return sequences
@@ -166,7 +165,7 @@ adjustHpBackwards
 --          call f() return to Nothing updfr_off: 32
 
 
-directCall :: CLabel -> Arity -> [StgArg] -> FCode ()
+directCall :: CLabel -> RepArity -> [StgArg] -> FCode ()
 -- (directCall f n args)
 -- calls f(arg1, ..., argn), and applies the result to the remaining args
 -- The function f has arity n, and there are guaranteed at least n args
@@ -182,27 +181,24 @@ slowCall fun stg_args
   = do  { dflags <- getDynFlags
         ; argsreps <- getArgRepsAmodes stg_args
         ; let (rts_fun, arity) = slowCallPattern (map fst argsreps)
-        ; let platform = targetPlatform dflags
         ; call <- getCode $ direct_call "slow_call"
                        (mkRtsApFastLabel rts_fun) arity argsreps
         ; emitComment $ mkFastString ("slow_call for " ++
-                                      showSDoc (pprPlatform platform fun) ++
-                                      " with pat " ++ showSDoc (ftext rts_fun))
+                                      showSDoc dflags (ppr fun) ++
+                                      " with pat " ++ unpackFS rts_fun)
         ; emit (mkAssign nodeReg fun <*> call)
         }
 
 
 --------------
-direct_call :: String -> CLabel -> Arity -> [(ArgRep,Maybe CmmExpr)] -> FCode ()
+direct_call :: String -> CLabel -> RepArity -> [(ArgRep,Maybe CmmExpr)] -> FCode ()
 direct_call caller lbl arity args
   | debugIsOn && arity > length args  -- Too few args
   = do -- Caller should ensure that there enough args!
-       dflags <- getDynFlags
-       let platform = targetPlatform dflags
        pprPanic "direct_call" $
             text caller <+> ppr arity <+>
-            pprPlatform platform lbl <+> ppr (length args) <+>
-            pprPlatform platform (map snd args) <+> ppr (map fst args)
+            ppr lbl <+> ppr (length args) <+>
+            ppr (map snd args) <+> ppr (map fst args)
 
   | null rest_args  -- Precisely the right number of arguments
   = emitCall (NativeDirectCall, NativeReturn) target (nonVArgs args)
@@ -289,7 +285,7 @@ slowArgs args -- careful: reps contains voids (V), but args does not
 
 
 -- These cases were found to cover about 99% of all slow calls:
-slowCallPattern :: [ArgRep] -> (FastString, Arity)
+slowCallPattern :: [ArgRep] -> (FastString, RepArity)
 -- Returns the generic apply function and arity
 slowCallPattern (P: P: P: P: P: P: _) = (fsLit "stg_ap_pppppp", 6)
 slowCallPattern (P: P: P: P: P: _)    = (fsLit "stg_ap_ppppp", 5)
@@ -532,9 +528,8 @@ emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args body
 emitClosureAndInfoTable ::
   CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
 emitClosureAndInfoTable info_tbl conv args body
-  = do { dflags <- getDynFlags
-       ; blks <- getCode body
-       ; let entry_lbl = toEntryLbl (targetPlatform dflags) (cit_lbl info_tbl)
+  = do { blks <- getCode body
+       ; let entry_lbl = toEntryLbl (cit_lbl info_tbl)
        ; emitProcWithConvention conv info_tbl entry_lbl args blks
        }
 
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index 240469c3f2..cc9919a4a0 100644
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -203,13 +203,13 @@ data CgLoc
 	-- To tail-call it, assign to these locals, 
 	-- and branch to the block id
 
-instance PlatformOutputable CgIdInfo where
-  pprPlatform platform (CgIdInfo { cg_id = id, cg_loc = loc })
-    = ppr id <+> ptext (sLit "-->") <+> pprPlatform platform loc
+instance Outputable CgIdInfo where
+  ppr (CgIdInfo { cg_id = id, cg_loc = loc })
+    = ppr id <+> ptext (sLit "-->") <+> ppr loc
 
-instance PlatformOutputable CgLoc where
-  pprPlatform platform (CmmLoc e)    = ptext (sLit "cmm") <+> pprPlatform platform e
-  pprPlatform _        (LneLoc b rs) = ptext (sLit "lne") <+> ppr b <+> ppr rs
+instance Outputable CgLoc where
+  ppr (CmmLoc e)    = ptext (sLit "cmm") <+> ppr e
+  ppr (LneLoc b rs) = ptext (sLit "lne") <+> ppr b <+> ppr rs
 
 
 -- Sequel tells what to do with the result of this expression
diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs
index 9f87271fba..bd783a3b30 100644
--- a/compiler/codeGen/StgCmmPrim.hs
+++ b/compiler/codeGen/StgCmmPrim.hs
@@ -45,6 +45,7 @@ import Module
 import FastString
 import Outputable
 import StaticFlags
+import Util
 
 ------------------------------------------------------------------------
 --	Primitive operations and foreign calls
@@ -475,11 +476,13 @@ emitPrimOp res WriteByteArrayOp_Word16    args = doWriteByteArrayOp (Just mo_Wor
 emitPrimOp res WriteByteArrayOp_Word32    args = doWriteByteArrayOp (Just mo_WordTo32) res args
 emitPrimOp res WriteByteArrayOp_Word64    args = doWriteByteArrayOp Nothing res args
 
--- Copying byte arrays
+-- Copying and setting byte arrays
 emitPrimOp [] CopyByteArrayOp [src,src_off,dst,dst_off,n] =
     doCopyByteArrayOp src src_off dst dst_off n
 emitPrimOp [] CopyMutableByteArrayOp [src,src_off,dst,dst_off,n] =
     doCopyMutableByteArrayOp src src_off dst dst_off n
+emitPrimOp [] SetByteArrayOp [ba,off,len,c] =
+    doSetByteArrayOp ba off len c
 
 -- Population count
 emitPrimOp [res] PopCnt8Op [w] = emitPopCntCall res w W8
@@ -811,6 +814,18 @@ emitCopyByteArray copy src src_off dst dst_off n = do
     copy src dst dst_p src_p n
 
 -- ----------------------------------------------------------------------------
+-- Setting byte arrays
+
+-- | Takes a 'MutableByteArray#', an offset into the array, a length,
+-- and a byte, and sets each of the selected bytes in the array to the
+-- character.
+doSetByteArrayOp :: CmmExpr -> CmmExpr -> CmmExpr -> CmmExpr
+                 -> FCode ()
+doSetByteArrayOp ba off len c
+    = do p <- assignTempE $ cmmOffsetExpr (cmmOffsetB ba arrWordsHdrSize) off
+         emitMemsetCall p c len (CmmLit (mkIntCLit 1))
+
+-- ----------------------------------------------------------------------------
 -- Copying pointer arrays
 
 -- EZY: This code has an unusually high amount of assignTemp calls, seen
diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs
index c147708cef..9ff4d0be07 100644
--- a/compiler/codeGen/StgCmmProf.hs
+++ b/compiler/codeGen/StgCmmProf.hs
@@ -218,7 +218,8 @@ emitCostCentreDecl cc = do
   ; modl  <- newByteStringCLit (bytesFS $ Module.moduleNameFS
                                         $ Module.moduleName
                                         $ cc_mod cc)
-  ; loc <- newStringCLit (showSDoc (ppr (costCentreSrcSpan cc)))
+  ; dflags <- getDynFlags
+  ; loc <- newStringCLit (showPpr dflags (costCentreSrcSpan cc))
            -- XXX should UTF-8 encode
                 -- All cost centres will be in the main package, since we
                 -- don't normally use -auto-all or add SCCs to other packages.
diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs
index ea74a03e1e..698bf32709 100644
--- a/compiler/codeGen/StgCmmTicky.hs
+++ b/compiler/codeGen/StgCmmTicky.hs
@@ -97,10 +97,9 @@ emitTickyCounter cl_info args
   = ifTicky $
     do	{ dflags <- getDynFlags
         ; mod_name <- getModuleName
-        ; let platform = targetPlatform dflags
-              ticky_ctr_label = closureRednCountsLabel platform cl_info
+        ; let ticky_ctr_label = closureRednCountsLabel cl_info
               arg_descr = map (showTypeCategory . idType) args
-              fun_descr mod_name = ppr_for_ticky_name mod_name (closureName cl_info)
+              fun_descr mod_name = ppr_for_ticky_name dflags mod_name (closureName cl_info)
 	; fun_descr_lit <- newStringCLit (fun_descr mod_name)
 	; arg_descr_lit <- newStringCLit arg_descr
 	; emitDataLits ticky_ctr_label 	-- Must match layout of StgEntCounter
@@ -120,10 +119,10 @@ emitTickyCounter cl_info args
 -- When printing the name of a thing in a ticky file, we want to
 -- give the module name even for *local* things.   We print
 -- just "x (M)" rather that "M.x" to distinguish them from the global kind.
-ppr_for_ticky_name :: Module -> Name -> String
-ppr_for_ticky_name mod_name name
-  | isInternalName name = showSDocDebug (ppr name <+> (parens (ppr mod_name)))
-  | otherwise	        = showSDocDebug (ppr name)
+ppr_for_ticky_name :: DynFlags -> Module -> Name -> String
+ppr_for_ticky_name dflags mod_name name
+  | isInternalName name = showSDocDebug dflags (ppr name <+> (parens (ppr mod_name)))
+  | otherwise           = showSDocDebug dflags (ppr name)
 
 -- -----------------------------------------------------------------------------
 -- Ticky stack frames
@@ -197,7 +196,7 @@ registerTickyCtr ctr_lbl
 		   (CmmLit (mkIntCLit 1)) ]
     ticky_entry_ctrs = mkLblExpr (mkCmmDataLabel rtsPackageId (fsLit "ticky_entry_ctrs"))
 
-tickyReturnOldCon, tickyReturnNewCon :: Arity -> FCode ()
+tickyReturnOldCon, tickyReturnNewCon :: RepArity -> FCode ()
 tickyReturnOldCon arity 
   = ifTicky $ do { bumpTickyCounter (fsLit "RET_OLD_ctr")
 	         ; bumpHistogram    (fsLit "RET_OLD_hst") arity }
@@ -205,7 +204,7 @@ tickyReturnNewCon arity
   = ifTicky $ do { bumpTickyCounter (fsLit "RET_NEW_ctr")
 	         ; bumpHistogram    (fsLit "RET_NEW_hst") arity }
 
-tickyUnboxedTupleReturn :: Int -> FCode ()
+tickyUnboxedTupleReturn :: RepArity -> FCode ()
 tickyUnboxedTupleReturn arity
   = ifTicky $ do { bumpTickyCounter (fsLit "RET_UNBOXED_TUP_ctr")
  	         ; bumpHistogram    (fsLit "RET_UNBOXED_TUP_hst") arity }
@@ -219,7 +218,7 @@ tickyVectoredReturn family_size
 -- Ticky calls
 
 -- Ticks at a *call site*:
-tickyDirectCall :: Arity -> [StgArg] -> FCode ()
+tickyDirectCall :: RepArity -> [StgArg] -> FCode ()
 tickyDirectCall arity args
   | arity == length args = tickyKnownCallExact
   | otherwise = do tickyKnownCallExtraArgs
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 246d57cda9..7609cfe38d 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -79,6 +79,8 @@ import FastString
 import Outputable
 
 import Data.Char
+import Data.List
+import Data.Ord
 import Data.Word
 import Data.Maybe
 
@@ -458,7 +460,7 @@ newUnboxedTupleRegs res_ty
 	; ASSERT( regs `equalLength` reps )
 	  return (regs, map primRepForeignHint reps) }
   where
-    ty_args = tyConAppArgs (repType res_ty)
+    UbxTupleRep ty_args = repType res_ty
     reps = [ rep
 	   | ty <- ty_args
     	   , let rep = typePrimRep ty
@@ -573,16 +575,13 @@ mkCmmSwitch via_C tag_expr branches mb_deflt lo_tag hi_tag = do
     branches_lbls <- label_branches join_lbl branches
     tag_expr'     <- assignTemp' tag_expr
     
-    emit =<< mk_switch tag_expr' (sortLe le branches_lbls) mb_deflt_lbl
+    emit =<< mk_switch tag_expr' (sortBy (comparing fst) branches) mb_deflt_lbl
                 lo_tag hi_tag via_C
 
           -- Sort the branches before calling mk_switch
 
     emitLabel join_lbl
 
-  where
-    (t1,_) `le` (t2,_) = t1 <= t2
-
 mk_switch :: CmmExpr -> [(ConTagZ, BlockId)]
 	  -> Maybe BlockId 
 	  -> ConTagZ -> ConTagZ -> Bool
@@ -736,10 +735,9 @@ emitCmmLitSwitch scrut  branches deflt = do
     join_lbl <- newLabelC
     deflt_lbl <- label_code join_lbl deflt
     branches_lbls <- label_branches join_lbl branches
-    emit =<< mk_lit_switch scrut' deflt_lbl (sortLe le branches_lbls)
+    emit =<< mk_lit_switch scrut' deflt_lbl
+               (sortBy (comparing fst) branches_lbls)
     emitLabel join_lbl
-  where
-    le (t1,_) (t2,_) = t1 <= t2
 
 mk_lit_switch :: CmmExpr -> BlockId 
  	      -> [(Literal,BlockId)]