Make StgHalfWord a portable type

It's now a newtyped Integer. Perhaps a newtyped Word32 would make more
sense, though.

12 files changed, 164 insertions, 132 deletions

diff --git a/compiler/cmm/CmmBuildInfoTables.hs b/compiler/cmm/CmmBuildInfoTables.hs
index 30e0addbdc..fe8c599ef6 100644
--- a/compiler/cmm/CmmBuildInfoTables.hs
+++ b/compiler/cmm/CmmBuildInfoTables.hs
@@ -228,7 +228,7 @@ maxBmpSize dflags = widthInBits (wordWidth dflags) `div` 2
 -- Adapted from codeGen/StgCmmUtils, which converts from SRT to C_SRT.
 to_SRT :: DynFlags -> CLabel -> Int -> Int -> Bitmap -> UniqSM (Maybe CmmDecl, C_SRT)
 to_SRT dflags top_srt off len bmp
-  | len > maxBmpSize dflags || bmp == [fromIntegral srt_escape]
+  | len > maxBmpSize dflags || bmp == [fromInteger (fromStgHalfWord (srt_escape dflags))]
   = do id <- getUniqueM
        let srt_desc_lbl = mkLargeSRTLabel id
            tbl = CmmData RelocatableReadOnlyData $
@@ -236,9 +236,9 @@ to_SRT dflags top_srt off len bmp
                      ( cmmLabelOffW dflags top_srt off
                      : mkWordCLit dflags (fromIntegral len)
                      : map (mkWordCLit dflags) bmp)
-       return (Just tbl, C_SRT srt_desc_lbl 0 srt_escape)
+       return (Just tbl, C_SRT srt_desc_lbl 0 (srt_escape dflags))
   | otherwise
-  = return (Nothing, C_SRT top_srt off (fromIntegral (head bmp)))
+  = return (Nothing, C_SRT top_srt off (toStgHalfWord dflags (toInteger (head bmp))))
 	-- The fromIntegral converts to StgHalfWord
 
 -- Gather CAF info for a procedure, but only if the procedure
diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs
index a93d1155ce..4dd74438ac 100644
--- a/compiler/cmm/CmmInfo.hs
+++ b/compiler/cmm/CmmInfo.hs
@@ -177,19 +177,22 @@ mkInfoTableContents dflags
        ; let
              std_info = mkStdInfoTable dflags prof_lits rts_tag srt_bitmap liveness_lit
              rts_tag | Just tag <- mb_rts_tag = tag
-                     | null liveness_data     = rET_SMALL -- Fits in extra_bits
-                     | otherwise              = rET_BIG   -- Does not; extra_bits is
-                                                          -- a label
+                     | null liveness_data     = rET_SMALL dflags -- Fits in extra_bits
+                     | otherwise              = rET_BIG   dflags -- Does not; extra_bits is
+                                                                 -- a label
        ; return (prof_data ++ liveness_data, (std_info, srt_label)) }
 
   | HeapRep _ ptrs nonptrs closure_type <- smrep
-  = do { let layout  = packHalfWordsCLit dflags (fromIntegral ptrs) (fromIntegral nonptrs)
+  = do { let layout  = packHalfWordsCLit
+                           dflags
+                           (toStgHalfWord dflags (toInteger ptrs))
+                           (toStgHalfWord dflags (toInteger nonptrs))
        ; (prof_lits, prof_data) <- mkProfLits dflags prof
        ; let (srt_label, srt_bitmap) = mkSRTLit dflags srt
        ; (mb_srt_field, mb_layout, extra_bits, ct_data)
                                 <- mk_pieces closure_type srt_label
        ; let std_info = mkStdInfoTable dflags prof_lits
-                                       (mb_rts_tag   `orElse` rtsClosureType smrep)
+                                       (mb_rts_tag   `orElse` rtsClosureType dflags smrep)
                                        (mb_srt_field `orElse` srt_bitmap)
                                        (mb_layout    `orElse` layout)
        ; return (prof_data ++ ct_data, (std_info, extra_bits)) }
@@ -207,7 +210,7 @@ mkInfoTableContents dflags
       = return (Nothing, Nothing, srt_label, [])
 
     mk_pieces (ThunkSelector offset) _no_srt
-      = return (Just 0, Just (mkWordCLit dflags offset), [], [])
+      = return (Just (toStgHalfWord dflags 0), Just (mkWordCLit dflags offset), [], [])
          -- Layout known (one free var); we use the layout field for offset
 
     mk_pieces (Fun arity (ArgSpec fun_type)) srt_label 
@@ -216,8 +219,8 @@ mkInfoTableContents dflags
 
     mk_pieces (Fun arity (ArgGen arg_bits)) srt_label
       = do { (liveness_lit, liveness_data) <- mkLivenessBits dflags arg_bits
-           ; let fun_type | null liveness_data = aRG_GEN
-                          | otherwise          = aRG_GEN_BIG
+           ; let fun_type | null liveness_data = aRG_GEN     dflags
+                          | otherwise          = aRG_GEN_BIG dflags
                  extra_bits = [ packHalfWordsCLit dflags fun_type arity
                               , srt_lit, liveness_lit, slow_entry ]
            ; return (Nothing, Nothing, extra_bits, liveness_data) }
@@ -236,7 +239,7 @@ mkSRTLit :: DynFlags
          -> C_SRT
          -> ([CmmLit],    -- srt_label, if any
              StgHalfWord) -- srt_bitmap
-mkSRTLit _      NoC_SRT                = ([], 0)
+mkSRTLit dflags NoC_SRT                = ([], toStgHalfWord dflags 0)
 mkSRTLit dflags (C_SRT lbl off bitmap) = ([cmmLabelOffW dflags lbl off], bitmap)
 
 
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 3061062a4c..e064149630 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -259,12 +259,12 @@ cmmproc :: { ExtCode }
                         code (emitProc Nothing (mkCmmCodeLabel pkg $1) formals blks) }
 
 info    :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
-        : 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
+        : 'INFO_TABLE' '(' NAME ',' INT ',' INT ',' stgHalfWord ',' STRING ',' STRING ')'
                 -- ptrs, nptrs, closure type, description, type
                 {% withThisPackage $ \pkg ->
                    do dflags <- getDynFlags
                       let prof = profilingInfo dflags $11 $13
-                          rep  = mkRTSRep (fromIntegral $9) $
+                          rep  = mkRTSRep $9 $
                                    mkHeapRep dflags False (fromIntegral $5)
                                                    (fromIntegral $7) Thunk
                               -- not really Thunk, but that makes the info table
@@ -275,14 +275,14 @@ info    :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
                                            , cit_prof = prof, cit_srt = NoC_SRT },
                               []) }
 
-        | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' INT ',' STRING ',' STRING ',' INT ')'
+        | 'INFO_TABLE_FUN' '(' NAME ',' INT ',' INT ',' stgHalfWord ',' STRING ',' STRING ',' stgHalfWord ')'
                 -- ptrs, nptrs, closure type, description, type, fun type
                 {% withThisPackage $ \pkg ->
                    do dflags <- getDynFlags
                       let prof = profilingInfo dflags $11 $13
-                          ty   = Fun 0 (ArgSpec (fromIntegral $15))
+                          ty   = Fun (toStgHalfWord dflags 0) (ArgSpec $15)
                                 -- Arity zero, arg_type $15
-                          rep = mkRTSRep (fromIntegral $9) $
+                          rep = mkRTSRep $9 $
                                     mkHeapRep dflags False (fromIntegral $5)
                                                     (fromIntegral $7) ty
                       return (mkCmmEntryLabel pkg $3,
@@ -293,14 +293,14 @@ info    :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
                 -- we leave most of the fields zero here.  This is only used
                 -- to generate the BCO info table in the RTS at the moment.
 
-        | 'INFO_TABLE_CONSTR' '(' NAME ',' INT ',' INT ',' INT ',' INT ',' STRING ',' STRING ')'
+        | 'INFO_TABLE_CONSTR' '(' NAME ',' INT ',' INT ',' stgHalfWord ',' stgHalfWord ',' STRING ',' STRING ')'
                 -- ptrs, nptrs, tag, closure type, description, type
                 {% withThisPackage $ \pkg ->
                    do dflags <- getDynFlags
                       let prof = profilingInfo dflags $13 $15
-                          ty  = Constr (fromIntegral $9)  -- Tag
+                          ty  = Constr $9  -- Tag
                                        (stringToWord8s $13)
-                          rep = mkRTSRep (fromIntegral $11) $
+                          rep = mkRTSRep $11 $
                                   mkHeapRep dflags False (fromIntegral $5)
                                                   (fromIntegral $7) ty
                       return (mkCmmEntryLabel pkg $3,
@@ -312,13 +312,13 @@ info    :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
                      -- If profiling is on, this string gets duplicated,
                      -- but that's the way the old code did it we can fix it some other time.
 
-        | 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' INT ',' STRING ',' STRING ')'
+        | 'INFO_TABLE_SELECTOR' '(' NAME ',' INT ',' stgHalfWord ',' STRING ',' STRING ')'
                 -- selector, closure type, description, type
                 {% withThisPackage $ \pkg ->
                    do dflags <- getDynFlags
                       let prof = profilingInfo dflags $9 $11
                           ty  = ThunkSelector (fromIntegral $5)
-                          rep = mkRTSRep (fromIntegral $7) $
+                          rep = mkRTSRep $7 $
                                    mkHeapRep dflags False 0 0 ty
                       return (mkCmmEntryLabel pkg $3,
                               CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
@@ -326,25 +326,25 @@ info    :: { ExtFCode (CLabel, CmmInfoTable, [Maybe LocalReg]) }
                                            , cit_prof = prof, cit_srt = NoC_SRT },
                               []) }
 
-        | 'INFO_TABLE_RET' '(' NAME ',' INT ')'
+        | 'INFO_TABLE_RET' '(' NAME ',' stgHalfWord ')'
                 -- closure type (no live regs)
                 {% withThisPackage $ \pkg ->
                    do let prof = NoProfilingInfo
-                          rep  = mkRTSRep (fromIntegral $5) $ mkStackRep []
+                          rep  = mkRTSRep $5 $ mkStackRep []
                       return (mkCmmRetLabel pkg $3,
                               CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
                                            , cit_rep = rep
                                            , cit_prof = prof, cit_srt = NoC_SRT },
                               []) }
 
-        | 'INFO_TABLE_RET' '(' NAME ',' INT ',' formals_without_hints0 ')'
+        | 'INFO_TABLE_RET' '(' NAME ',' stgHalfWord ',' formals_without_hints0 ')'
                 -- closure type, live regs
                 {% withThisPackage $ \pkg ->
                    do dflags <- getDynFlags
                       live <- sequence (map (liftM Just) $7)
                       let prof = NoProfilingInfo
                           bitmap = mkLiveness dflags live
-                          rep  = mkRTSRep (fromIntegral $5) $ mkStackRep bitmap
+                          rep  = mkRTSRep $5 $ mkStackRep bitmap
                       return (mkCmmRetLabel pkg $3,
                               CmmInfoTable { cit_lbl = mkCmmInfoLabel pkg $3
                                            , cit_rep = rep
@@ -613,6 +613,10 @@ typenot8 :: { CmmType }
         | 'float32'             { f32 }
         | 'float64'             { f64 }
         | 'gcptr'               {% do dflags <- getDynFlags; return $ gcWord dflags }
+
+stgHalfWord :: { StgHalfWord }
+        : INT                   {% do dflags <- getDynFlags; return $ toStgHalfWord dflags $1 }
+
 {
 section :: String -> Section
 section "text"      = Text
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index 8cbe46360c..fab384cd3c 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -168,8 +168,8 @@ packHalfWordsCLit dflags lower_half_word upper_half_word
    = if wORDS_BIGENDIAN dflags
      then mkWordCLit dflags ((l `shiftL` hALF_WORD_SIZE_IN_BITS) .|. u)
      else mkWordCLit dflags (l .|. (u `shiftL` hALF_WORD_SIZE_IN_BITS))
-    where l = fromIntegral lower_half_word
-          u = fromIntegral upper_half_word
+    where l = fromInteger (fromStgHalfWord lower_half_word)
+          u = fromInteger (fromStgHalfWord upper_half_word)
 
 ---------------------------------------------------
 --
diff --git a/compiler/cmm/PprCmmDecl.hs b/compiler/cmm/PprCmmDecl.hs
index ab320b4100..d2491d3089 100644
--- a/compiler/cmm/PprCmmDecl.hs
+++ b/compiler/cmm/PprCmmDecl.hs
@@ -127,7 +127,7 @@ pprInfoTable (CmmInfoTable { cit_lbl = lbl, cit_rep = rep
 instance Outputable C_SRT where
   ppr NoC_SRT = ptext (sLit "_no_srt_")
   ppr (C_SRT label off bitmap)
-      = parens (ppr label <> comma <> ppr off <> comma <> text (show bitmap))
+      = parens (ppr label <> comma <> ppr off <> comma <> ppr bitmap)
 
 instance Outputable ForeignHint where
   ppr NoHint     = empty
diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs
index 2c9cb32ec0..4443158f89 100644
--- a/compiler/cmm/SMRep.lhs
+++ b/compiler/cmm/SMRep.lhs
@@ -11,7 +11,8 @@ Other modules should access this info through ClosureInfo.
 \begin{code}
 module SMRep (
         -- * Words and bytes
-        StgWord, StgHalfWord,
+        StgWord,
+        StgHalfWord, fromStgHalfWord, toStgHalfWord,
         hALF_WORD_SIZE, hALF_WORD_SIZE_IN_BITS,
         WordOff, ByteOff,
         roundUpToWords,
@@ -46,6 +47,7 @@ module SMRep (
 
 import DynFlags
 import Outputable
+import Platform
 import FastString
 
 import Data.Char( ord )
@@ -71,16 +73,32 @@ roundUpToWords dflags n = (n + (wORD_SIZE dflags - 1)) .&. (complement (wORD_SIZ
 StgWord is a type representing an StgWord on the target platform.
 
 \begin{code}
+newtype StgHalfWord = StgHalfWord Integer
+    deriving Eq
+
+fromStgHalfWord :: StgHalfWord -> Integer
+fromStgHalfWord (StgHalfWord i) = i
+
+toStgHalfWord :: DynFlags -> Integer -> StgHalfWord
+toStgHalfWord dflags i
+    = case platformWordSize (targetPlatform dflags) of
+      -- These conversions mean that things like toStgHalfWord (-1)
+      -- do the right thing
+      4 -> StgHalfWord (toInteger (fromInteger i :: Word16))
+      8 -> StgHalfWord (toInteger (fromInteger i :: Word32))
+      w -> panic ("toStgHalfWord: Unknown platformWordSize: " ++ show w)
+
+instance Outputable StgHalfWord where
+    ppr (StgHalfWord i) = integer i
+
 #if SIZEOF_HSWORD == 4
 type StgWord     = Word32
-type StgHalfWord = Word16
 hALF_WORD_SIZE :: ByteOff
 hALF_WORD_SIZE = 2
 hALF_WORD_SIZE_IN_BITS :: Int
 hALF_WORD_SIZE_IN_BITS = 16
 #elif SIZEOF_HSWORD == 8
 type StgWord     = Word64
-type StgHalfWord = Word32
 hALF_WORD_SIZE :: ByteOff
 hALF_WORD_SIZE = 4
 hALF_WORD_SIZE_IN_BITS :: Int
@@ -277,49 +295,52 @@ closureTypeHdrSize dflags ty = case ty of
 -- Defines CONSTR, CONSTR_1_0 etc
 
 -- | Derives the RTS closure type from an 'SMRep'
-rtsClosureType :: SMRep -> StgHalfWord
-rtsClosureType (RTSRep ty _)  = ty
-
-rtsClosureType (HeapRep False 1 0 Constr{}) = CONSTR_1_0
-rtsClosureType (HeapRep False 0 1 Constr{}) = CONSTR_0_1
-rtsClosureType (HeapRep False 2 0 Constr{}) = CONSTR_2_0
-rtsClosureType (HeapRep False 1 1 Constr{}) = CONSTR_1_1
-rtsClosureType (HeapRep False 0 2 Constr{}) = CONSTR_0_2
-rtsClosureType (HeapRep False _ _ Constr{}) = CONSTR
-
-rtsClosureType (HeapRep False 1 0 Fun{}) = FUN_1_0
-rtsClosureType (HeapRep False 0 1 Fun{}) = FUN_0_1
-rtsClosureType (HeapRep False 2 0 Fun{}) = FUN_2_0
-rtsClosureType (HeapRep False 1 1 Fun{}) = FUN_1_1
-rtsClosureType (HeapRep False 0 2 Fun{}) = FUN_0_2
-rtsClosureType (HeapRep False _ _ Fun{}) = FUN
-
-rtsClosureType (HeapRep False 1 0 Thunk{}) = THUNK_1_0
-rtsClosureType (HeapRep False 0 1 Thunk{}) = THUNK_0_1
-rtsClosureType (HeapRep False 2 0 Thunk{}) = THUNK_2_0
-rtsClosureType (HeapRep False 1 1 Thunk{}) = THUNK_1_1
-rtsClosureType (HeapRep False 0 2 Thunk{}) = THUNK_0_2
-rtsClosureType (HeapRep False _ _ Thunk{}) = THUNK
-
-rtsClosureType (HeapRep False _ _ ThunkSelector{}) =  THUNK_SELECTOR
-
--- Approximation: we use the CONSTR_NOCAF_STATIC type for static constructors
--- that have no pointer words only.
-rtsClosureType (HeapRep True 0 _ Constr{}) = CONSTR_NOCAF_STATIC  -- See isStaticNoCafCon below
-rtsClosureType (HeapRep True _ _ Constr{}) = CONSTR_STATIC
-rtsClosureType (HeapRep True _ _ Fun{})    = FUN_STATIC
-rtsClosureType (HeapRep True _ _ Thunk{})  = THUNK_STATIC
-
-rtsClosureType (HeapRep False _ _ BlackHole{}) =  BLACKHOLE
-
-rtsClosureType _ = panic "rtsClosureType"
+rtsClosureType :: DynFlags -> SMRep -> StgHalfWord
+rtsClosureType dflags rep
+    = toStgHalfWord dflags
+    $ case rep of
+      RTSRep ty _ -> fromStgHalfWord ty
+
+      HeapRep False 1 0 Constr{} -> CONSTR_1_0
+      HeapRep False 0 1 Constr{} -> CONSTR_0_1
+      HeapRep False 2 0 Constr{} -> CONSTR_2_0
+      HeapRep False 1 1 Constr{} -> CONSTR_1_1
+      HeapRep False 0 2 Constr{} -> CONSTR_0_2
+      HeapRep False _ _ Constr{} -> CONSTR
+
+      HeapRep False 1 0 Fun{} -> FUN_1_0
+      HeapRep False 0 1 Fun{} -> FUN_0_1
+      HeapRep False 2 0 Fun{} -> FUN_2_0
+      HeapRep False 1 1 Fun{} -> FUN_1_1
+      HeapRep False 0 2 Fun{} -> FUN_0_2
+      HeapRep False _ _ Fun{} -> FUN
+
+      HeapRep False 1 0 Thunk{} -> THUNK_1_0
+      HeapRep False 0 1 Thunk{} -> THUNK_0_1
+      HeapRep False 2 0 Thunk{} -> THUNK_2_0
+      HeapRep False 1 1 Thunk{} -> THUNK_1_1
+      HeapRep False 0 2 Thunk{} -> THUNK_0_2
+      HeapRep False _ _ Thunk{} -> THUNK
+
+      HeapRep False _ _ ThunkSelector{} ->  THUNK_SELECTOR
+
+      -- Approximation: we use the CONSTR_NOCAF_STATIC type for static
+      -- constructors -- that have no pointer words only.
+      HeapRep True 0 _ Constr{} -> CONSTR_NOCAF_STATIC  -- See isStaticNoCafCon below
+      HeapRep True _ _ Constr{} -> CONSTR_STATIC
+      HeapRep True _ _ Fun{}    -> FUN_STATIC
+      HeapRep True _ _ Thunk{}  -> THUNK_STATIC
+
+      HeapRep False _ _ BlackHole{} -> BLACKHOLE
+
+      _ -> panic "rtsClosureType"
 
 -- We export these ones
-rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: StgHalfWord
-rET_SMALL   = RET_SMALL
-rET_BIG     = RET_BIG
-aRG_GEN     = ARG_GEN
-aRG_GEN_BIG = ARG_GEN_BIG
+rET_SMALL, rET_BIG, aRG_GEN, aRG_GEN_BIG :: DynFlags -> StgHalfWord
+rET_SMALL   dflags = toStgHalfWord dflags RET_SMALL
+rET_BIG     dflags = toStgHalfWord dflags RET_BIG
+aRG_GEN     dflags = toStgHalfWord dflags ARG_GEN
+aRG_GEN_BIG dflags = toStgHalfWord dflags ARG_GEN_BIG
 \end{code}
 
 Note [Static NoCaf constructors]
@@ -360,18 +381,18 @@ instance Outputable SMRep where
    ppr (RTSRep ty rep) = ptext (sLit "tag:") <> ppr ty <+> ppr rep
 
 instance Outputable ArgDescr where
-  ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> integer (toInteger n)
+  ppr (ArgSpec n) = ptext (sLit "ArgSpec") <+> ppr n
   ppr (ArgGen ls) = ptext (sLit "ArgGen") <+> ppr ls
 
 pprTypeInfo :: ClosureTypeInfo -> SDoc
 pprTypeInfo (Constr tag descr)
   = ptext (sLit "Con") <+>
-    braces (sep [ ptext (sLit "tag:") <+> integer (toInteger tag)
+    braces (sep [ ptext (sLit "tag:") <+> ppr tag
                 , ptext (sLit "descr:") <> text (show descr) ])
 
 pprTypeInfo (Fun arity args)
   = ptext (sLit "Fun") <+>
-    braces (sep [ ptext (sLit "arity:") <+> integer (toInteger arity)
+    braces (sep [ ptext (sLit "arity:") <+> ppr arity
                 , ptext (sLit ("fun_type:")) <+> ppr args ])
 
 pprTypeInfo (ThunkSelector offset)
diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs
index 45edd64666..e468936a7a 100644
--- a/compiler/codeGen/CgCallConv.hs
+++ b/compiler/codeGen/CgCallConv.hs
@@ -70,7 +70,7 @@ mkArgDescr _nm args
        let arg_bits = argBits dflags arg_reps
            arg_reps = filter nonVoidArg (map idCgRep args)
            -- Getting rid of voids eases matching of standard patterns
-       case stdPattern arg_reps of
+       case stdPattern dflags arg_reps of
            Just spec_id -> return (ArgSpec spec_id)
            Nothing      -> return (ArgGen arg_bits)
 
@@ -79,33 +79,36 @@ argBits _      []              = []
 argBits dflags (PtrArg : args) = False : argBits dflags args
 argBits dflags (arg    : args) = take (cgRepSizeW dflags arg) (repeat True) ++ argBits dflags args
 
-stdPattern :: [CgRep] -> Maybe StgHalfWord
-stdPattern []          = Just ARG_NONE  -- just void args, probably
-
-stdPattern [PtrArg]    = Just ARG_P
-stdPattern [FloatArg]  = Just ARG_F
-stdPattern [DoubleArg] = Just ARG_D
-stdPattern [LongArg]   = Just ARG_L
-stdPattern [NonPtrArg] = Just ARG_N
-
-stdPattern [NonPtrArg,NonPtrArg] = Just ARG_NN
-stdPattern [NonPtrArg,PtrArg]    = Just ARG_NP
-stdPattern [PtrArg,NonPtrArg]    = Just ARG_PN
-stdPattern [PtrArg,PtrArg]       = Just ARG_PP
-
-stdPattern [NonPtrArg,NonPtrArg,NonPtrArg] = Just ARG_NNN
-stdPattern [NonPtrArg,NonPtrArg,PtrArg]    = Just ARG_NNP
-stdPattern [NonPtrArg,PtrArg,NonPtrArg]    = Just ARG_NPN
-stdPattern [NonPtrArg,PtrArg,PtrArg]       = Just ARG_NPP
-stdPattern [PtrArg,NonPtrArg,NonPtrArg]    = Just ARG_PNN
-stdPattern [PtrArg,NonPtrArg,PtrArg]       = Just ARG_PNP
-stdPattern [PtrArg,PtrArg,NonPtrArg]       = Just ARG_PPN
-stdPattern [PtrArg,PtrArg,PtrArg]          = Just ARG_PPP
-
-stdPattern [PtrArg,PtrArg,PtrArg,PtrArg]               = Just ARG_PPPP
-stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg]        = Just ARG_PPPPP
-stdPattern [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg,PtrArg] = Just ARG_PPPPPP
-stdPattern _ = Nothing
+stdPattern :: DynFlags -> [CgRep] -> Maybe StgHalfWord
+stdPattern dflags reps
+    = fmap (toStgHalfWord dflags)
+    $ case reps of
+      []          -> Just ARG_NONE  -- just void args, probably
+
+      [PtrArg]    -> Just ARG_P
+      [FloatArg]  -> Just ARG_F
+      [DoubleArg] -> Just ARG_D
+      [LongArg]   -> Just ARG_L
+      [NonPtrArg] -> Just ARG_N
+
+      [NonPtrArg,NonPtrArg] -> Just ARG_NN
+      [NonPtrArg,PtrArg]    -> Just ARG_NP
+      [PtrArg,NonPtrArg]    -> Just ARG_PN
+      [PtrArg,PtrArg]       -> Just ARG_PP
+
+      [NonPtrArg,NonPtrArg,NonPtrArg] -> Just ARG_NNN
+      [NonPtrArg,NonPtrArg,PtrArg]    -> Just ARG_NNP
+      [NonPtrArg,PtrArg,NonPtrArg]    -> Just ARG_NPN
+      [NonPtrArg,PtrArg,PtrArg]       -> Just ARG_NPP
+      [PtrArg,NonPtrArg,NonPtrArg]    -> Just ARG_PNN
+      [PtrArg,NonPtrArg,PtrArg]       -> Just ARG_PNP
+      [PtrArg,PtrArg,NonPtrArg]       -> Just ARG_PPN
+      [PtrArg,PtrArg,PtrArg]          -> Just ARG_PPP
+
+      [PtrArg,PtrArg,PtrArg,PtrArg]               -> Just ARG_PPPP
+      [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg]        -> Just ARG_PPPPP
+      [PtrArg,PtrArg,PtrArg,PtrArg,PtrArg,PtrArg] -> Just ARG_PPPPPP
+      _ -> Nothing
 
 
 -------------------------------------------------------------------------
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index c52c8a8c99..2abdb0e589 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -795,21 +795,21 @@ getSRTInfo = do
     NoSRT -> return NoC_SRT
     SRTEntries {} -> panic "getSRTInfo: SRTEntries.  Perhaps you forgot to run SimplStg?"
     SRT off len bmp
-      | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
+      | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromInteger (fromStgHalfWord (srt_escape dflags))]
       -> do id <- newUnique
             let srt_desc_lbl = mkLargeSRTLabel id
             emitRODataLits "getSRTInfo" srt_desc_lbl
              ( cmmLabelOffW dflags srt_lbl off
                : mkWordCLit dflags (fromIntegral len)
                : map (mkWordCLit dflags) bmp)
-            return (C_SRT srt_desc_lbl 0 srt_escape)
+            return (C_SRT srt_desc_lbl 0 (srt_escape dflags))
 
       | otherwise
-      -> return (C_SRT srt_lbl off (fromIntegral (head bmp)))
+      -> return (C_SRT srt_lbl off (toStgHalfWord dflags (toInteger (head bmp))))
                 -- The fromIntegral converts to StgHalfWord
 
-srt_escape :: StgHalfWord
-srt_escape = -1
+srt_escape :: DynFlags -> StgHalfWord
+srt_escape dflags = toStgHalfWord dflags (-1)
 
 -- -----------------------------------------------------------------------------
 --
diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs
index 7a72a00602..f06ee7840c 100644
--- a/compiler/codeGen/ClosureInfo.lhs
+++ b/compiler/codeGen/ClosureInfo.lhs
@@ -480,7 +480,7 @@ mkClosureInfo dflags is_static id lf_info tot_wds ptr_wds srt_info descr
 		    -- anything else gets eta expanded.
   where
     name   = idName id
-    sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds (lfClosureType lf_info)
+    sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds (lfClosureType dflags lf_info)
     nonptr_wds = tot_wds - ptr_wds
 
 mkConInfo :: DynFlags
@@ -492,7 +492,7 @@ mkConInfo dflags is_static data_con tot_wds ptr_wds
    = ConInfo {	closureSMRep = sm_rep,
 		closureCon = data_con }
   where
-    sm_rep  = mkHeapRep dflags is_static ptr_wds nonptr_wds (lfClosureType lf_info)
+    sm_rep  = mkHeapRep dflags is_static ptr_wds nonptr_wds (lfClosureType dflags lf_info)
     lf_info = mkConLFInfo data_con
     nonptr_wds = tot_wds - ptr_wds
 \end{code}
@@ -526,12 +526,12 @@ closureNeedsUpdSpace cl_info = closureUpdReqd cl_info
 %************************************************************************
 
 \begin{code}
-lfClosureType :: LambdaFormInfo -> ClosureTypeInfo
-lfClosureType (LFReEntrant _ arity _ argd) = Fun (fromIntegral arity) argd
-lfClosureType (LFCon con)                  = Constr (fromIntegral (dataConTagZ con))
-                                                    (dataConIdentity con)
-lfClosureType (LFThunk _ _ _ is_sel _) 	   = thunkClosureType is_sel
-lfClosureType _                 	   = panic "lfClosureType"
+lfClosureType :: DynFlags -> LambdaFormInfo -> ClosureTypeInfo
+lfClosureType dflags (LFReEntrant _ arity _ argd) = Fun (toStgHalfWord dflags (toInteger arity)) argd
+lfClosureType dflags (LFCon con)                  = Constr (toStgHalfWord dflags (toInteger (dataConTagZ con)))
+                                                           (dataConIdentity con)
+lfClosureType _      (LFThunk _ _ _ is_sel _)     = thunkClosureType is_sel
+lfClosureType _      _                            = panic "lfClosureType"
 
 thunkClosureType :: StandardFormInfo -> ClosureTypeInfo
 thunkClosureType (SelectorThunk off) = ThunkSelector (fromIntegral off)
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index 85346da205..2d767a6c6d 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -353,12 +353,12 @@ isLFReEntrant _                = False
 --		Choosing SM reps
 -----------------------------------------------------------------------------
 
-lfClosureType :: LambdaFormInfo -> ClosureTypeInfo
-lfClosureType (LFReEntrant _ arity _ argd) = Fun (fromIntegral arity) argd
-lfClosureType (LFCon con)                  = Constr (fromIntegral (dataConTagZ con))
-                                                      (dataConIdentity con)
-lfClosureType (LFThunk _ _ _ is_sel _) 	   = thunkClosureType is_sel
-lfClosureType _                 	   = panic "lfClosureType"
+lfClosureType :: DynFlags -> LambdaFormInfo -> ClosureTypeInfo
+lfClosureType dflags (LFReEntrant _ arity _ argd) = Fun (toStgHalfWord dflags (toInteger arity)) argd
+lfClosureType dflags (LFCon con)                  = Constr (toStgHalfWord dflags (toInteger (dataConTagZ con)))
+                                                           (dataConIdentity con)
+lfClosureType _      (LFThunk _ _ _ is_sel _)     = thunkClosureType is_sel
+lfClosureType _      _                            = panic "lfClosureType"
 
 thunkClosureType :: StandardFormInfo -> ClosureTypeInfo
 thunkClosureType (SelectorThunk off) = ThunkSelector (fromIntegral off)
@@ -687,7 +687,7 @@ mkClosureInfo dflags is_static id lf_info tot_wds ptr_wds val_descr
                   closureProf      = prof }     -- (we don't have an SRT yet)
   where
     name       = idName id
-    sm_rep     = mkHeapRep dflags is_static ptr_wds nonptr_wds (lfClosureType lf_info)
+    sm_rep     = mkHeapRep dflags is_static ptr_wds nonptr_wds (lfClosureType dflags lf_info)
     prof       = mkProfilingInfo dflags id val_descr
     nonptr_wds = tot_wds - ptr_wds
 
@@ -899,8 +899,8 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
 
    sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type
 
-   cl_type = Constr (fromIntegral (dataConTagZ data_con))
-                   (dataConIdentity data_con)
+   cl_type = Constr (toStgHalfWord dflags (toInteger (dataConTagZ data_con)))
+                    (dataConIdentity data_con)
 
    prof | not (dopt Opt_SccProfilingOn dflags) = NoProfilingInfo
         | otherwise                            = ProfilingInfo ty_descr val_descr
diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs
index 142100e109..df4cef4a31 100644
--- a/compiler/codeGen/StgCmmLayout.hs
+++ b/compiler/codeGen/StgCmmLayout.hs
@@ -469,7 +469,7 @@ mkArgDescr _nm args
        let arg_bits = argBits dflags arg_reps
            arg_reps = filter isNonV (map idArgRep args)
            -- Getting rid of voids eases matching of standard patterns
-       case stdPattern arg_reps of
+       case stdPattern dflags arg_reps of
            Just spec_id -> return (ArgSpec spec_id)
            Nothing      -> return (ArgGen arg_bits)
 
@@ -480,9 +480,10 @@ argBits dflags (arg : args) = take (argRepSizeW dflags arg) (repeat True)
                     ++ argBits dflags args
 
 ----------------------
-stdPattern :: [ArgRep] -> Maybe StgHalfWord
-stdPattern reps 
-  = case reps of
+stdPattern :: DynFlags -> [ArgRep] -> Maybe StgHalfWord
+stdPattern dflags reps
+  = fmap (toStgHalfWord dflags)
+  $ case reps of
 	[]  -> Just ARG_NONE	-- just void args, probably
 	[N] -> Just ARG_N
 	[P] -> Just ARG_P
diff --git a/compiler/codeGen/StgCmmUtils.hs b/compiler/codeGen/StgCmmUtils.hs
index 4471b78151..f5dc2b6d31 100644
--- a/compiler/codeGen/StgCmmUtils.hs
+++ b/compiler/codeGen/StgCmmUtils.hs
@@ -720,5 +720,5 @@ assignTemp' e
        emitAssign reg e
        return (CmmReg reg)
 
-srt_escape :: StgHalfWord
-srt_escape = -1
+srt_escape :: DynFlags -> StgHalfWord
+srt_escape dflags = toStgHalfWord dflags (-1)