Make the types we use when creating GHCi bytecode better match reality

We were keeping things as Int, and then converting them to Word16 at
the last minute, when really they ought to have been Word16 all along.

6 files changed, 166 insertions, 152 deletions

diff --git a/compiler/ghci/ByteCodeAsm.lhs b/compiler/ghci/ByteCodeAsm.lhs
index 968dbaaabd..1a99096a9b 100644
--- a/compiler/ghci/ByteCodeAsm.lhs
+++ b/compiler/ghci/ByteCodeAsm.lhs
@@ -41,6 +41,7 @@ import Data.Array.Base  ( UArray(..) )
 import Data.Array.ST    ( castSTUArray )
 import Foreign
 import Data.Char        ( ord )
+import Data.List
 
 import GHC.Base         ( ByteArray#, MutableByteArray#, RealWorld )
 
@@ -96,8 +97,8 @@ bcoFreeNames bco
 instance Outputable UnlinkedBCO where
    ppr (UnlinkedBCO nm _arity _insns _bitmap lits ptrs)
       = sep [text "BCO", ppr nm, text "with",
-             int (sizeSS lits), text "lits",
-             int (sizeSS ptrs), text "ptrs" ]
+             ppr (sizeSS lits), text "lits",
+             ppr (sizeSS ptrs), text "ptrs" ]
 
 -- -----------------------------------------------------------------------------
 -- The bytecode assembler
@@ -130,10 +131,11 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity _origin _malloced)
                      = case i of LABEL n -> addToFM env n i_offset ; _ -> env
               in  mkLabelEnv new_env (i_offset + instrSize16s i) is
 
+         findLabel :: Word16 -> Word16
          findLabel lab
             = case lookupFM label_env lab of
                  Just bco_offset -> bco_offset
-                 Nothing -> pprPanic "assembleBCO.findLabel" (int lab)
+                 Nothing -> pprPanic "assembleBCO.findLabel" (ppr lab)
      in
      do  -- pass 2: generate the instruction, ptr and nonptr bits
          insns <- return emptySS :: IO (SizedSeq Word16)
@@ -166,11 +168,11 @@ assembleBCO (ProtoBCO nm instrs bitmap bsize arity _origin _malloced)
      --     zonk ptr = do -- putStrLn ("freeing malloc'd block at " ++ show (A# a#))
      --                      free ptr
 
-mkBitmapArray :: Int -> [StgWord] -> UArray Int StgWord
+mkBitmapArray :: Word16 -> [StgWord] -> UArray Int StgWord
 mkBitmapArray bsize bitmap
   = listArray (0, length bitmap) (fromIntegral bsize : bitmap)
 
-mkInstrArray :: Int -> [Word16] -> UArray Int Word16
+mkInstrArray :: Word16 -> [Word16] -> UArray Word16 Word16
 mkInstrArray n_insns asm_insns
   = listArray (0, n_insns) (fromIntegral n_insns : asm_insns)
 
@@ -179,7 +181,7 @@ type AsmState = (SizedSeq Word16,
                  SizedSeq BCONPtr,
                  SizedSeq BCOPtr)
 
-data SizedSeq a = SizedSeq !Int [a]
+data SizedSeq a = SizedSeq !Word16 [a]
 emptySS :: SizedSeq a
 emptySS = SizedSeq 0 []
 
@@ -188,34 +190,34 @@ addToSS :: SizedSeq a -> a -> IO (SizedSeq a)
 addToSS (SizedSeq n r_xs) x = return (SizedSeq (n+1) (x:r_xs))
 addListToSS :: SizedSeq a -> [a] -> IO (SizedSeq a)
 addListToSS (SizedSeq n r_xs) xs
-   = return (SizedSeq (n + length xs) (reverse xs ++ r_xs))
+   = return (SizedSeq (n + genericLength xs) (reverse xs ++ r_xs))
 
 ssElts :: SizedSeq a -> [a]
 ssElts (SizedSeq _ r_xs) = reverse r_xs
 
-sizeSS :: SizedSeq a -> Int
+sizeSS :: SizedSeq a -> Word16
 sizeSS (SizedSeq n _) = n
 
 -- Bring in all the bci_ bytecode constants.
 #include "Bytecodes.h"
 
-largeArgInstr :: Int -> Int
+largeArgInstr :: Word16 -> Word16
 largeArgInstr bci = bci_FLAG_LARGE_ARGS .|. bci
 
-largeArg :: Int -> [Int]
-largeArg i
+largeArg :: Word -> [Word16]
+largeArg w
  | wORD_SIZE_IN_BITS == 64
-           = [(i .&. 0xFFFF000000000000) `shiftR` 48,
-              (i .&. 0x0000FFFF00000000) `shiftR` 32,
-              (i .&. 0x00000000FFFF0000) `shiftR` 16,
-              (i .&. 0x000000000000FFFF)]
+           = [fromIntegral (w `shiftR` 48),
+              fromIntegral (w `shiftR` 32),
+              fromIntegral (w `shiftR` 16),
+              fromIntegral w]
  | wORD_SIZE_IN_BITS == 32
-           = [(i .&. 0xFFFF0000) `shiftR` 16,
-              (i .&. 0x0000FFFF)]
+           = [fromIntegral (w `shiftR` 16),
+              fromIntegral w]
  | otherwise = error "wORD_SIZE_IN_BITS not 32 or 64?"
 
 -- This is where all the action is (pass 2 of the assembler)
-mkBits :: (Int -> Int)                  -- label finder
+mkBits :: (Word16 -> Word16)            -- label finder
        -> AsmState
        -> [BCInstr]                     -- instructions (in)
        -> IO AsmState
@@ -229,7 +231,7 @@ mkBits findLabel st proto_insns
                STKCHECK  n
                 | n > 65535 ->
                        instrn st (largeArgInstr bci_STKCHECK : largeArg n)
-                | otherwise -> instr2 st bci_STKCHECK n
+                | otherwise -> instr2 st bci_STKCHECK (fromIntegral n)
                PUSH_L    o1       -> instr2 st bci_PUSH_L o1
                PUSH_LL   o1 o2    -> instr3 st bci_PUSH_LL o1 o2
                PUSH_LLL  o1 o2 o3 -> instr4 st bci_PUSH_LLL o1 o2 o3
@@ -303,35 +305,32 @@ mkBits findLabel st proto_insns
                   (p2, st3) <- ptr st2 (BCOPtrBreakInfo info)
                   instr4 st3 bci_BRK_FUN p1 index p2
 
-       i2s :: Int -> Word16
-       i2s = fromIntegral
-
-       instrn :: AsmState -> [Int] -> IO AsmState
+       instrn :: AsmState -> [Word16] -> IO AsmState
        instrn st [] = return st
        instrn (st_i, st_l, st_p) (i:is)
-          = do st_i' <- addToSS st_i (i2s i)
+          = do st_i' <- addToSS st_i i
                instrn (st_i', st_l, st_p) is
 
        instr1 (st_i0,st_l0,st_p0) i1
           = do st_i1 <- addToSS st_i0 i1
                return (st_i1,st_l0,st_p0)
 
-       instr2 (st_i0,st_l0,st_p0) i1 i2
-          = do st_i1 <- addToSS st_i0 (i2s i1)
-               st_i2 <- addToSS st_i1 (i2s i2)
+       instr2 (st_i0,st_l0,st_p0) w1 w2
+          = do st_i1 <- addToSS st_i0 w1
+               st_i2 <- addToSS st_i1 w2
                return (st_i2,st_l0,st_p0)
 
-       instr3 (st_i0,st_l0,st_p0) i1 i2 i3
-          = do st_i1 <- addToSS st_i0 (i2s i1)
-               st_i2 <- addToSS st_i1 (i2s i2)
-               st_i3 <- addToSS st_i2 (i2s i3)
+       instr3 (st_i0,st_l0,st_p0) w1 w2 w3
+          = do st_i1 <- addToSS st_i0 w1
+               st_i2 <- addToSS st_i1 w2
+               st_i3 <- addToSS st_i2 w3
                return (st_i3,st_l0,st_p0)
 
-       instr4 (st_i0,st_l0,st_p0) i1 i2 i3 i4
-          = do st_i1 <- addToSS st_i0 (i2s i1)
-               st_i2 <- addToSS st_i1 (i2s i2)
-               st_i3 <- addToSS st_i2 (i2s i3)
-               st_i4 <- addToSS st_i3 (i2s i4)
+       instr4 (st_i0,st_l0,st_p0) w1 w2 w3 w4
+          = do st_i1 <- addToSS st_i0 w1
+               st_i2 <- addToSS st_i1 w2
+               st_i3 <- addToSS st_i2 w3
+               st_i4 <- addToSS st_i3 w4
                return (st_i4,st_l0,st_p0)
 
        float (st_i0,st_l0,st_p0) f
@@ -389,7 +388,7 @@ mkBits findLabel st proto_insns
        literal _  other            = pprPanic "ByteCodeAsm.literal" (ppr other)
 
 
-push_alts :: CgRep -> Int
+push_alts :: CgRep -> Word16
 push_alts NonPtrArg = bci_PUSH_ALTS_N
 push_alts FloatArg  = bci_PUSH_ALTS_F
 push_alts DoubleArg = bci_PUSH_ALTS_D
@@ -407,7 +406,7 @@ return_ubx PtrArg    = bci_RETURN_P
 
 
 -- The size in 16-bit entities of an instruction.
-instrSize16s :: BCInstr -> Int
+instrSize16s :: BCInstr -> Word16
 instrSize16s instr
    = case instr of
         STKCHECK{}              -> 2
diff --git a/compiler/ghci/ByteCodeGen.lhs b/compiler/ghci/ByteCodeGen.lhs
index 0df09d63d3..8a4b5e29a9 100644
--- a/compiler/ghci/ByteCodeGen.lhs
+++ b/compiler/ghci/ByteCodeGen.lhs
@@ -123,11 +123,11 @@ coreExprToBCOs dflags expr
 
 type BCInstrList = OrdList BCInstr
 
-type Sequel = Int	-- back off to this depth before ENTER
+type Sequel = Word16 -- back off to this depth before ENTER
 
 -- Maps Ids to the offset from the stack _base_ so we don't have
 -- to mess with it after each push/pop.
-type BCEnv = FiniteMap Id Int	-- To find vars on the stack
+type BCEnv = FiniteMap Id Word16 -- To find vars on the stack
 
 {-
 ppBCEnv :: BCEnv -> SDoc
@@ -147,7 +147,7 @@ mkProtoBCO
    -> BCInstrList
    -> Either  [AnnAlt Id VarSet] (AnnExpr Id VarSet)
    -> Int
-   -> Int
+   -> Word16
    -> [StgWord]
    -> Bool   	-- True <=> is a return point, rather than a function
    -> [BcPtr]
@@ -171,13 +171,13 @@ mkProtoBCO nm instrs_ordlist origin arity bitmap_size bitmap is_ret mallocd_bloc
         -- (hopefully rare) cases when the (overestimated) stack use
         -- exceeds iNTERP_STACK_CHECK_THRESH.
         maybe_with_stack_check
-	   | is_ret && stack_usage < aP_STACK_SPLIM = peep_d
+	   | is_ret && stack_usage < fromIntegral aP_STACK_SPLIM = peep_d
 		-- don't do stack checks at return points,
 		-- everything is aggregated up to the top BCO
 		-- (which must be a function).
                 -- That is, unless the stack usage is >= AP_STACK_SPLIM,
                 -- see bug #1466.
-           | stack_usage >= iNTERP_STACK_CHECK_THRESH
+           | stack_usage >= fromIntegral iNTERP_STACK_CHECK_THRESH
            = STKCHECK stack_usage : peep_d
            | otherwise
            = peep_d	-- the supposedly common case
@@ -275,13 +275,13 @@ schemeR_wrk fvs nm original_body (args, body)
 	 -- \fv1..fvn x1..xn -> e 
 	 -- i.e. the fvs come first
 
-         szsw_args = map idSizeW all_args
+         szsw_args = map (fromIntegral . idSizeW) all_args
          szw_args  = sum szsw_args
          p_init    = listToFM (zip all_args (mkStackOffsets 0 szsw_args))
 
 	 -- make the arg bitmap
 	 bits = argBits (reverse (map idCgRep all_args))
-	 bitmap_size = length bits
+	 bitmap_size = genericLength bits
 	 bitmap = mkBitmap bits
      in do
      body_code <- schemeER_wrk szw_args p_init body   
@@ -290,12 +290,12 @@ schemeR_wrk fvs nm original_body (args, body)
 		arity bitmap_size bitmap False{-not alts-})
 
 -- introduce break instructions for ticked expressions
-schemeER_wrk :: Int -> BCEnv -> AnnExpr' Id VarSet -> BcM BCInstrList
+schemeER_wrk :: Word16 -> BCEnv -> AnnExpr' Id VarSet -> BcM BCInstrList
 schemeER_wrk d p rhs
    | Just (tickInfo, (_annot, newRhs)) <- isTickedExp' rhs = do 
         code <- schemeE d 0 p newRhs 
         arr <- getBreakArray 
-        let idOffSets = getVarOffSets d p tickInfo 
+        let idOffSets = getVarOffSets (fromIntegral d) p tickInfo 
         let tickNumber = tickInfo_number tickInfo
         let breakInfo = BreakInfo 
                         { breakInfo_module = tickInfo_module tickInfo
@@ -303,14 +303,16 @@ schemeER_wrk d p rhs
                         , breakInfo_vars = idOffSets
                         , breakInfo_resty = exprType (deAnnotate' newRhs)
                         }
-        let breakInstr = case arr of (BA arr#) -> BRK_FUN arr# tickNumber breakInfo 
+        let breakInstr = case arr of
+                         BA arr# ->
+                             BRK_FUN arr# (fromIntegral tickNumber) breakInfo
         return $ breakInstr `consOL` code
    | otherwise = schemeE d 0 p rhs 
 
-getVarOffSets :: Int -> BCEnv -> TickInfo -> [(Id, Int)]
+getVarOffSets :: Word16 -> BCEnv -> TickInfo -> [(Id, Word16)]
 getVarOffSets d p = catMaybes . map (getOffSet d p) . tickInfo_locals 
 
-getOffSet :: Int -> BCEnv -> Id -> Maybe (Id, Int)
+getOffSet :: Word16 -> BCEnv -> Id -> Maybe (Id, Word16)
 getOffSet d env id 
    = case lookupBCEnv_maybe env id of
         Nothing     -> Nothing 
@@ -346,7 +348,7 @@ instance Outputable TickInfo where
 
 -- Compile code to apply the given expression to the remaining args
 -- on the stack, returning a HNF.
-schemeE :: Int -> Sequel -> BCEnv -> AnnExpr' Id VarSet -> BcM BCInstrList
+schemeE :: Word16 -> Sequel -> BCEnv -> AnnExpr' Id VarSet -> BcM BCInstrList
 
 schemeE d s p e
    | Just e' <- bcView e
@@ -366,7 +368,7 @@ schemeE d s p e@(AnnVar v)
         -- Heave it on the stack, SLIDE, and RETURN.
         (push, szw) <- pushAtom d p (AnnVar v)
         return (push 			-- value onto stack
-                  `appOL`  mkSLIDE szw (d-s) 	-- clear to sequel
+                  `appOL`  mkSLIDE szw (d-s) -- clear to sequel
                   `snocOL` RETURN_UBX v_rep)	-- go
    where
       v_type = idType v
@@ -395,21 +397,21 @@ schemeE d s p (AnnLet (AnnNonRec x (_,rhs)) (_,body))
 schemeE d s p (AnnLet binds (_,body))
    = let (xs,rhss) = case binds of AnnNonRec x rhs  -> ([x],[rhs])
                                    AnnRec xs_n_rhss -> unzip xs_n_rhss
-         n_binds = length xs
+         n_binds = genericLength xs
 
          fvss  = map (fvsToEnv p' . fst) rhss
 
          -- Sizes of free vars
-         sizes = map (\rhs_fvs -> sum (map idSizeW rhs_fvs)) fvss
+         sizes = map (\rhs_fvs -> sum (map (fromIntegral . idSizeW) rhs_fvs)) fvss
 
 	 -- the arity of each rhs
-	 arities = map (length . fst . collect) rhss
+	 arities = map (genericLength . fst . collect) rhss
 
          -- This p', d' defn is safe because all the items being pushed
          -- are ptrs, so all have size 1.  d' and p' reflect the stack
          -- after the closures have been allocated in the heap (but not
          -- filled in), and pointers to them parked on the stack.
-         p'    = addListToFM p (zipE xs (mkStackOffsets d (nOfThem n_binds 1)))
+         p'    = addListToFM p (zipE xs (mkStackOffsets d (genericReplicate n_binds 1)))
          d'    = d + n_binds
          zipE  = zipEqual "schemeE"
 
@@ -436,7 +438,7 @@ schemeE d s p (AnnLet binds (_,body))
 
 	 compile_bind d' fvs x rhs size arity off = do
 		bco <- schemeR fvs (x,rhs)
-		build_thunk d' fvs size bco off arity
+		build_thunk (fromIntegral d') fvs size bco off arity
 
 	 compile_binds = 
 	    [ compile_bind d' fvs x rhs size arity n
@@ -584,7 +586,7 @@ isTickedExp' _ = Nothing
 -- 4.  Otherwise, it must be a function call.  Push the args
 --     right to left, SLIDE and ENTER.
 
-schemeT :: Int 		-- Stack depth
+schemeT :: Word16       -- Stack depth
         -> Sequel 	-- Sequel depth
         -> BCEnv 	-- stack env
         -> AnnExpr' Id VarSet 
@@ -667,7 +669,7 @@ schemeT d s p app
 -- Generate code to build a constructor application, 
 -- leaving it on top of the stack
 
-mkConAppCode :: Int -> Sequel -> BCEnv
+mkConAppCode :: Word16 -> Sequel -> BCEnv
 	     -> DataCon 		-- The data constructor
 	     -> [AnnExpr' Id VarSet] 	-- Args, in *reverse* order
 	     -> BcM BCInstrList
@@ -704,7 +706,7 @@ mkConAppCode orig_d _ p con args_r_to_l
 -- returned, even if it is a pointed type.  We always just return.
 
 unboxedTupleReturn
-	:: Int -> Sequel -> BCEnv
+	:: Word16 -> Sequel -> BCEnv
 	-> AnnExpr' Id VarSet -> BcM BCInstrList
 unboxedTupleReturn d s p arg = do
   (push, sz) <- pushAtom d p arg
@@ -716,7 +718,7 @@ unboxedTupleReturn d s p arg = do
 -- Generate code for a tail-call
 
 doTailCall
-	:: Int -> Sequel -> BCEnv
+	:: Word16 -> Sequel -> BCEnv
 	-> Id -> [AnnExpr' Id VarSet]
 	-> BcM BCInstrList
 doTailCall init_d s p fn args
@@ -773,7 +775,7 @@ findPushSeq _
 -- -----------------------------------------------------------------------------
 -- Case expressions
 
-doCase  :: Int -> Sequel -> BCEnv
+doCase  :: Word16 -> Sequel -> BCEnv
 	-> AnnExpr Id VarSet -> Id -> [AnnAlt Id VarSet]
 	-> Bool  -- True <=> is an unboxed tuple case, don't enter the result
 	-> BcM BCInstrList
@@ -791,7 +793,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
 	  		    | otherwise = 1
 
 	-- depth of stack after the return value has been pushed
-	d_bndr = d + ret_frame_sizeW + idSizeW bndr
+	d_bndr = d + ret_frame_sizeW + fromIntegral (idSizeW bndr)
 
 	-- depth of stack after the extra info table for an unboxed return
 	-- has been pushed, if any.  This is the stack depth at the
@@ -819,8 +821,8 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
            | otherwise =
              let
 		 (ptrs,nptrs) = partition (isFollowableArg.idCgRep) real_bndrs
-		 ptr_sizes    = map idSizeW ptrs
-		 nptrs_sizes  = map idSizeW nptrs
+		 ptr_sizes    = map (fromIntegral . idSizeW) ptrs
+		 nptrs_sizes  = map (fromIntegral . idSizeW) nptrs
 		 bind_sizes   = ptr_sizes ++ nptrs_sizes
 		 size         = sum ptr_sizes + sum nptrs_sizes
 		 -- the UNPACK instruction unpacks in reverse order...
@@ -839,7 +841,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
            | isUnboxedTupleCon dc
            = unboxedTupleException
            | otherwise
-           = DiscrP (dataConTag dc - fIRST_TAG)
+           = DiscrP (fromIntegral (dataConTag dc - fIRST_TAG))
         my_discr (LitAlt l, _, _)
            = case l of MachInt i     -> DiscrI (fromInteger i)
                        MachFloat r   -> DiscrF (fromRational r)
@@ -869,11 +871,13 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
         -- case-of-case expressions, which is the only time we can be compiling a
         -- case expression with s /= 0.
         bitmap_size = d-s
-	bitmap = intsToReverseBitmap bitmap_size{-size-} 
-                        (sortLe (<=) (filter (< bitmap_size) rel_slots))
+        bitmap_size' :: Int
+        bitmap_size' = fromIntegral bitmap_size
+	bitmap = intsToReverseBitmap bitmap_size'{-size-}
+                        (sortLe (<=) (filter (< bitmap_size') rel_slots))
 	  where
 	  binds = fmToList p
-	  rel_slots = concat (map spread binds)
+	  rel_slots = map fromIntegral $ concat (map spread binds)
 	  spread (id, offset)
 		| isFollowableArg (idCgRep id) = [ rel_offset ]
 		| otherwise = []
@@ -907,7 +911,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
 -- (machine) code for the ccall, and create bytecodes to call that and
 -- then return in the right way.  
 
-generateCCall :: Int -> Sequel 		-- stack and sequel depths
+generateCCall :: Word16 -> Sequel 		-- stack and sequel depths
               -> BCEnv
               -> CCallSpec		-- where to call
               -> Id 			-- of target, for type info
@@ -917,7 +921,8 @@ generateCCall :: Int -> Sequel 		-- stack and sequel depths
 generateCCall d0 s p (CCallSpec target cconv _) fn args_r_to_l
    = let 
          -- useful constants
-         addr_sizeW = cgRepSizeW NonPtrArg
+         addr_sizeW :: Word16
+         addr_sizeW = fromIntegral (cgRepSizeW NonPtrArg)
 
          -- Get the args on the stack, with tags and suitably
          -- dereferenced for the CCall.  For each arg, return the
@@ -934,12 +939,12 @@ generateCCall d0 s p (CCallSpec target cconv _) fn args_r_to_l
 		    Just (t, _)
 		     | t == arrayPrimTyCon || t == mutableArrayPrimTyCon
                        -> do rest <- pargs (d + addr_sizeW) az
-                             code <- parg_ArrayishRep arrPtrsHdrSize d p a
+                             code <- parg_ArrayishRep (fromIntegral arrPtrsHdrSize) d p a
                              return ((code,AddrRep):rest)
 
 		     | t == byteArrayPrimTyCon || t == mutableByteArrayPrimTyCon
                        -> do rest <- pargs (d + addr_sizeW) az
-                             code <- parg_ArrayishRep arrWordsHdrSize d p a
+                             code <- parg_ArrayishRep (fromIntegral arrWordsHdrSize) d p a
                              return ((code,AddrRep):rest)
 
                     -- Default case: push taggedly, but otherwise intact.
@@ -951,6 +956,8 @@ generateCCall d0 s p (CCallSpec target cconv _) fn args_r_to_l
          -- Do magic for Ptr/Byte arrays.  Push a ptr to the array on
          -- the stack but then advance it over the headers, so as to
          -- point to the payload.
+         parg_ArrayishRep :: Word16 -> Word16 -> BCEnv -> AnnExpr' Id VarSet
+                          -> BcM BCInstrList
          parg_ArrayishRep hdrSize d p a
             = do (push_fo, _) <- pushAtom d p a
                  -- The ptr points at the header.  Advance it over the
@@ -961,7 +968,7 @@ generateCCall d0 s p (CCallSpec target cconv _) fn args_r_to_l
      code_n_reps <- pargs d0 args_r_to_l
      let
          (pushs_arg, a_reps_pushed_r_to_l) = unzip code_n_reps
-         a_reps_sizeW = sum (map primRepSizeW a_reps_pushed_r_to_l)
+         a_reps_sizeW = fromIntegral (sum (map primRepSizeW a_reps_pushed_r_to_l))
 
          push_args    = concatOL pushs_arg
          d_after_args = d0 + a_reps_sizeW
@@ -1054,7 +1061,7 @@ generateCCall d0 s p (CCallSpec target cconv _) fn args_r_to_l
 
          -- Push the return placeholder.  For a call returning nothing,
          -- this is a VoidArg (tag).
-         r_sizeW   = primRepSizeW r_rep
+         r_sizeW   = fromIntegral (primRepSizeW r_rep)
          d_after_r = d_after_Addr + r_sizeW
          r_lit     = mkDummyLiteral r_rep
          push_r    = (if   returns_void 
@@ -1149,7 +1156,7 @@ maybe_getCCallReturnRep fn_ty
 implement_tagToId :: [Name] -> BcM BCInstrList
 implement_tagToId names
    = ASSERT( notNull names )
-     do labels <- getLabelsBc (length names)
+     do labels <- getLabelsBc (genericLength names)
         label_fail <- getLabelBc
         label_exit <- getLabelBc
         let infos = zip4 labels (tail labels ++ [label_fail])
@@ -1179,7 +1186,7 @@ implement_tagToId names
 -- to 5 and not to 4.  Stack locations are numbered from zero, so a
 -- depth 6 stack has valid words 0 .. 5.
 
-pushAtom :: Int -> BCEnv -> AnnExpr' Id VarSet -> BcM (BCInstrList, Int)
+pushAtom :: Word16 -> BCEnv -> AnnExpr' Id VarSet -> BcM (BCInstrList, Word16)
 
 pushAtom d p e 
    | Just e' <- bcView e 
@@ -1196,7 +1203,8 @@ pushAtom d p (AnnVar v)
    = return (unitOL (PUSH_PRIMOP primop), 1)
 
    | Just d_v <- lookupBCEnv_maybe p v  -- v is a local variable
-   = return (toOL (nOfThem sz (PUSH_L (d-d_v+sz-2))), sz)
+   = let l = d - fromIntegral d_v + sz - 2
+     in return (toOL (genericReplicate sz (PUSH_L l)), sz)
 	 -- d - d_v 		    the number of words between the TOS 
 	 --			    and the 1st slot of the object
 	 --
@@ -1213,7 +1221,8 @@ pushAtom d p (AnnVar v)
       return (unitOL (PUSH_G (getName v)), sz)
 
     where
-         sz = idSizeW v
+         sz :: Word16
+         sz = fromIntegral (idSizeW v)
 
 
 pushAtom _ _ (AnnLit lit)
@@ -1229,7 +1238,7 @@ pushAtom _ _ (AnnLit lit)
         l             -> pprPanic "pushAtom" (ppr l)
      where
         code rep
-           = let size_host_words = cgRepSizeW rep
+           = let size_host_words = fromIntegral (cgRepSizeW rep)
              in  return (unitOL (PUSH_UBX (Left lit) size_host_words), 
                            size_host_words)
 
@@ -1342,7 +1351,8 @@ mkMultiBranch maybe_ncons raw_ways
 
          (algMinBound, algMaxBound)
             = case maybe_ncons of
-                 Just n  -> (0, n - 1)
+                 -- XXX What happens when n == 0?
+                 Just n  -> (0, fromIntegral n - 1)
                  Nothing -> (minBound, maxBound)
 
          (DiscrI i1) `eqAlt` (DiscrI i2) = i1 == i2
@@ -1386,18 +1396,18 @@ data Discr
    = DiscrI Int
    | DiscrF Float
    | DiscrD Double
-   | DiscrP Int
+   | DiscrP Word16
    | NoDiscr
 
 instance Outputable Discr where
    ppr (DiscrI i) = int i
    ppr (DiscrF f) = text (show f)
    ppr (DiscrD d) = text (show d)
-   ppr (DiscrP i) = int i
+   ppr (DiscrP i) = ppr i
    ppr NoDiscr    = text "DEF"
 
 
-lookupBCEnv_maybe :: BCEnv -> Id -> Maybe Int
+lookupBCEnv_maybe :: BCEnv -> Id -> Maybe Word16
 lookupBCEnv_maybe = lookupFM
 
 idSizeW :: Id -> Int
@@ -1413,7 +1423,7 @@ unboxedTupleException
             "  Workaround: use -fobject-code, or compile this module to .o separately."))
 
 
-mkSLIDE :: Int -> Int -> OrdList BCInstr
+mkSLIDE :: Word16 -> Word16 -> OrdList BCInstr
 mkSLIDE n d = if d == 0 then nilOL else unitOL (SLIDE n d)
 
 splitApp :: AnnExpr' Var ann -> (AnnExpr' Var ann, [AnnExpr' Var ann])
@@ -1458,7 +1468,7 @@ isPtrAtom e = atomRep e == PtrArg
 -- Let szsw be the sizes in words of some items pushed onto the stack,
 -- which has initial depth d'.  Return the values which the stack environment
 -- should map these items to.
-mkStackOffsets :: Int -> [Int] -> [Int]
+mkStackOffsets :: Word16 -> [Word16] -> [Word16]
 mkStackOffsets original_depth szsw
    = map (subtract 1) (tail (scanl (+) original_depth szsw))
 
@@ -1470,7 +1480,7 @@ type BcPtr = Either ItblPtr (Ptr ())
 data BcM_State 
    = BcM_State { 
         uniqSupply :: UniqSupply,       -- for generating fresh variable names
-	nextlabel :: Int,		-- for generating local labels
+	nextlabel :: Word16,		-- for generating local labels
 	malloced  :: [BcPtr],		-- thunks malloced for current BCO
 					-- Should be free()d when it is GCd
         breakArray :: BreakArray        -- array of breakpoint flags 
@@ -1522,11 +1532,11 @@ recordItblMallocBc :: ItblPtr -> BcM ()
 recordItblMallocBc a
   = BcM $ \st -> return (st{malloced = Left a : malloced st}, ())
 
-getLabelBc :: BcM Int
+getLabelBc :: BcM Word16
 getLabelBc
   = BcM $ \st -> return (st{nextlabel = 1 + nextlabel st}, nextlabel st)
 
-getLabelsBc :: Int -> BcM [Int]
+getLabelsBc :: Word16 -> BcM [Word16]
 getLabelsBc n
   = BcM $ \st -> let ctr = nextlabel st 
 		 in return (st{nextlabel = ctr+n}, [ctr .. ctr+n-1])
diff --git a/compiler/ghci/ByteCodeInstr.lhs b/compiler/ghci/ByteCodeInstr.lhs
index 84472f24ac..20828266fb 100644
--- a/compiler/ghci/ByteCodeInstr.lhs
+++ b/compiler/ghci/ByteCodeInstr.lhs
@@ -29,7 +29,7 @@ import SMRep
 
 import Module (Module)
 import GHC.Exts
-
+import Data.Word
 
 -- ----------------------------------------------------------------------------
 -- Bytecode instructions
@@ -40,7 +40,7 @@ data ProtoBCO a
 	protoBCOInstrs     :: [BCInstr],  -- instrs
 	-- arity and GC info
 	protoBCOBitmap     :: [StgWord],
-	protoBCOBitmapSize :: Int,
+	protoBCOBitmapSize :: Word16,
 	protoBCOArity	   :: Int,
 	-- what the BCO came from
 	protoBCOExpr       :: Either  [AnnAlt Id VarSet] (AnnExpr Id VarSet),
@@ -48,16 +48,16 @@ data ProtoBCO a
         protoBCOPtrs       :: [Either ItblPtr (Ptr ())]
    }
 
-type LocalLabel = Int
+type LocalLabel = Word16
 
 data BCInstr
    -- Messing with the stack
-   = STKCHECK  Int
+   = STKCHECK  Word
 
    -- Push locals (existing bits of the stack)
-   | PUSH_L    !Int{-offset-}
-   | PUSH_LL   !Int !Int{-2 offsets-}
-   | PUSH_LLL  !Int !Int !Int{-3 offsets-}
+   | PUSH_L    !Word16{-offset-}
+   | PUSH_LL   !Word16 !Word16{-2 offsets-}
+   | PUSH_LLL  !Word16 !Word16 !Word16{-3 offsets-}
 
    -- Push a ptr  (these all map to PUSH_G really)
    | PUSH_G       Name
@@ -69,8 +69,8 @@ data BCInstr
    | PUSH_ALTS_UNLIFTED (ProtoBCO Name) CgRep
 
    -- Pushing literals
-   | PUSH_UBX  (Either Literal (Ptr ())) Int
-	-- push this int/float/double/addr, on the stack.  Int
+   | PUSH_UBX  (Either Literal (Ptr ())) Word16
+	-- push this int/float/double/addr, on the stack. Word16
 	-- is # of words to copy from literal pool.  Eitherness reflects
 	-- the difficulty of dealing with MachAddr here, mostly due to
 	-- the excessive (and unnecessary) restrictions imposed by the
@@ -92,16 +92,16 @@ data BCInstr
    | PUSH_APPLY_PPPPP
    | PUSH_APPLY_PPPPPP
 
-   | SLIDE     Int{-this many-} Int{-down by this much-}
+   | SLIDE     Word16{-this many-} Word16{-down by this much-}
 
    -- To do with the heap
-   | ALLOC_AP  !Int	 -- make an AP with this many payload words
-   | ALLOC_AP_NOUPD !Int -- make an AP_NOUPD with this many payload words
-   | ALLOC_PAP !Int !Int -- make a PAP with this arity / payload words
-   | MKAP      !Int{-ptr to AP is this far down stack-} !Int{-number of words-}
-   | MKPAP     !Int{-ptr to PAP is this far down stack-} !Int{-number of words-}
-   | UNPACK    !Int	-- unpack N words from t.o.s Constr
-   | PACK      DataCon !Int
+   | ALLOC_AP  !Word16 -- make an AP with this many payload words
+   | ALLOC_AP_NOUPD !Word16 -- make an AP_NOUPD with this many payload words
+   | ALLOC_PAP !Word16 !Word16 -- make a PAP with this arity / payload words
+   | MKAP      !Word16{-ptr to AP is this far down stack-} !Word16{-number of words-}
+   | MKPAP     !Word16{-ptr to PAP is this far down stack-} !Word16{-number of words-}
+   | UNPACK    !Word16 -- unpack N words from t.o.s Constr
+   | PACK      DataCon !Word16
 			-- after assembly, the DataCon is an index into the
 			-- itbl array
    -- For doing case trees
@@ -113,22 +113,22 @@ data BCInstr
    | TESTLT_D  Double LocalLabel
    | TESTEQ_D  Double LocalLabel
 
-   -- The Int value is a constructor number and therefore
+   -- The Word16 value is a constructor number and therefore
    -- stored in the insn stream rather than as an offset into
    -- the literal pool.
-   | TESTLT_P  Int    LocalLabel
-   | TESTEQ_P  Int    LocalLabel
+   | TESTLT_P  Word16 LocalLabel
+   | TESTEQ_P  Word16 LocalLabel
 
    | CASEFAIL
    | JMP              LocalLabel
 
    -- For doing calls to C (via glue code generated by ByteCodeFFI, or libffi)
-   | CCALL            Int 	-- stack frame size
-		      (Ptr ())  -- addr of the glue code
+   | CCALL            Word16    -- stack frame size
+                      (Ptr ())  -- addr of the glue code
 
    -- For doing magic ByteArray passing to foreign calls
-   | SWIZZLE          Int	-- to the ptr N words down the stack,
-		      Int	-- add M (interpreted as a signed 16-bit entity)
+   | SWIZZLE          Word16 -- to the ptr N words down the stack,
+                      Word16 -- add M (interpreted as a signed 16-bit entity)
 
    -- To Infinity And Beyond
    | ENTER
@@ -136,13 +136,13 @@ data BCInstr
    | RETURN_UBX CgRep -- return an unlifted value, here's its rep
 
    -- Breakpoints 
-   | BRK_FUN          (MutableByteArray# RealWorld) Int BreakInfo
+   | BRK_FUN          (MutableByteArray# RealWorld) Word16 BreakInfo
 
 data BreakInfo 
    = BreakInfo
    { breakInfo_module :: Module
    , breakInfo_number :: {-# UNPACK #-} !Int
-   , breakInfo_vars   :: [(Id,Int)]
+   , breakInfo_vars   :: [(Id,Word16)]
    , breakInfo_resty  :: Type
    }
 
@@ -167,10 +167,10 @@ instance Outputable a => Outputable (ProtoBCO a) where
               Right rhs -> pprCoreExpr (deAnnotate rhs)
 
 instance Outputable BCInstr where
-   ppr (STKCHECK n)          = text "STKCHECK" <+> int n
-   ppr (PUSH_L offset)       = text "PUSH_L  " <+> int offset
-   ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> int o1 <+> int o2
-   ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> int o1 <+> int o2 <+> int o3
+   ppr (STKCHECK n)          = text "STKCHECK" <+> ppr n
+   ppr (PUSH_L offset)       = text "PUSH_L  " <+> ppr offset
+   ppr (PUSH_LL o1 o2)       = text "PUSH_LL " <+> ppr o1 <+> ppr o2
+   ppr (PUSH_LLL o1 o2 o3)   = text "PUSH_LLL" <+> ppr o1 <+> ppr o2 <+> ppr o3
    ppr (PUSH_G nm)  	     = text "PUSH_G  " <+> ppr nm
    ppr (PUSH_PRIMOP op)      = text "PUSH_G  " <+> text "GHC.PrimopWrappers." 
                                                <> ppr op
@@ -178,8 +178,8 @@ instance Outputable BCInstr where
    ppr (PUSH_ALTS bco)       = text "PUSH_ALTS " <+> ppr bco
    ppr (PUSH_ALTS_UNLIFTED bco pk) = text "PUSH_ALTS_UNLIFTED " <+> ppr pk <+> ppr bco
 
-   ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (int nw) <+> ppr lit
-   ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (int nw) <+> text (show aa)
+   ppr (PUSH_UBX (Left lit) nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> ppr lit
+   ppr (PUSH_UBX (Right aa) nw) = text "PUSH_UBX" <+> parens (ppr nw) <+> text (show aa)
    ppr PUSH_APPLY_N		= text "PUSH_APPLY_N"
    ppr PUSH_APPLY_V		= text "PUSH_APPLY_V"
    ppr PUSH_APPLY_F		= text "PUSH_APPLY_F"
@@ -192,36 +192,36 @@ instance Outputable BCInstr where
    ppr PUSH_APPLY_PPPPP		= text "PUSH_APPLY_PPPPP"
    ppr PUSH_APPLY_PPPPPP	= text "PUSH_APPLY_PPPPPP"
 
-   ppr (SLIDE n d)           = text "SLIDE   " <+> int n <+> int d
-   ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> int sz
-   ppr (ALLOC_AP_NOUPD sz)   = text "ALLOC_AP_NOUPD   " <+> int sz
-   ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> int arity <+> int sz
-   ppr (MKAP offset sz)      = text "MKAP    " <+> int sz <+> text "words," 
-                                               <+> int offset <+> text "stkoff"
-   ppr (MKPAP offset sz)     = text "MKPAP   " <+> int sz <+> text "words,"
-                                               <+> int offset <+> text "stkoff"
-   ppr (UNPACK sz)           = text "UNPACK  " <+> int sz
+   ppr (SLIDE n d)           = text "SLIDE   " <+> ppr n <+> ppr d
+   ppr (ALLOC_AP sz)         = text "ALLOC_AP   " <+> ppr sz
+   ppr (ALLOC_AP_NOUPD sz)   = text "ALLOC_AP_NOUPD   " <+> ppr sz
+   ppr (ALLOC_PAP arity sz)  = text "ALLOC_PAP   " <+> ppr arity <+> ppr sz
+   ppr (MKAP offset sz)      = text "MKAP    " <+> ppr sz <+> text "words," 
+                                               <+> ppr offset <+> text "stkoff"
+   ppr (MKPAP offset sz)     = text "MKPAP   " <+> ppr sz <+> text "words,"
+                                               <+> ppr offset <+> text "stkoff"
+   ppr (UNPACK sz)           = text "UNPACK  " <+> ppr sz
    ppr (PACK dcon sz)        = text "PACK    " <+> ppr dcon <+> ppr sz
-   ppr (LABEL     lab)       = text "__"       <> int lab <> colon
-   ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> int lab
-   ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> int lab
-   ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> int lab
-   ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> int lab
-   ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> int lab
-   ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> int lab
-   ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> int i <+> text "__" <> int lab
-   ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> int i <+> text "__" <> int lab
+   ppr (LABEL     lab)       = text "__"       <> ppr lab <> colon
+   ppr (TESTLT_I  i lab)     = text "TESTLT_I" <+> int i <+> text "__" <> ppr lab
+   ppr (TESTEQ_I  i lab)     = text "TESTEQ_I" <+> int i <+> text "__" <> ppr lab
+   ppr (TESTLT_F  f lab)     = text "TESTLT_F" <+> float f <+> text "__" <> ppr lab
+   ppr (TESTEQ_F  f lab)     = text "TESTEQ_F" <+> float f <+> text "__" <> ppr lab
+   ppr (TESTLT_D  d lab)     = text "TESTLT_D" <+> double d <+> text "__" <> ppr lab
+   ppr (TESTEQ_D  d lab)     = text "TESTEQ_D" <+> double d <+> text "__" <> ppr lab
+   ppr (TESTLT_P  i lab)     = text "TESTLT_P" <+> ppr i <+> text "__" <> ppr lab
+   ppr (TESTEQ_P  i lab)     = text "TESTEQ_P" <+> ppr i <+> text "__" <> ppr lab
    ppr CASEFAIL              = text "CASEFAIL"
-   ppr (JMP lab)             = text "JMP"      <+> int lab
-   ppr (CCALL off marshall_addr) = text "CCALL   " <+> int off 
+   ppr (JMP lab)             = text "JMP"      <+> ppr lab
+   ppr (CCALL off marshall_addr) = text "CCALL   " <+> ppr off 
 						<+> text "marshall code at" 
                                                <+> text (show marshall_addr)
-   ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> int stkoff 
-                                               <+> text "by" <+> int n 
+   ppr (SWIZZLE stkoff n)    = text "SWIZZLE " <+> text "stkoff" <+> ppr stkoff
+                                               <+> text "by" <+> ppr n
    ppr ENTER                 = text "ENTER"
    ppr RETURN		     = text "RETURN"
    ppr (RETURN_UBX pk)       = text "RETURN_UBX  " <+> ppr pk
-   ppr (BRK_FUN _breakArray index info) = text "BRK_FUN" <+> text "<array>" <+> int index <+> ppr info 
+   ppr (BRK_FUN _breakArray index info) = text "BRK_FUN" <+> text "<array>" <+> ppr index <+> ppr info
 
 -- -----------------------------------------------------------------------------
 -- The stack use, in words, of each bytecode insn.  These _must_ be
@@ -233,10 +233,10 @@ instance Outputable BCInstr where
 -- This could all be made more accurate by keeping track of a proper
 -- stack high water mark, but it doesn't seem worth the hassle.
 
-protoBCOStackUse :: ProtoBCO a -> Int
+protoBCOStackUse :: ProtoBCO a -> Word
 protoBCOStackUse bco = sum (map bciStackUse (protoBCOInstrs bco))
 
-bciStackUse :: BCInstr -> Int
+bciStackUse :: BCInstr -> Word
 bciStackUse STKCHECK{}            = 0
 bciStackUse PUSH_L{}       	  = 1
 bciStackUse PUSH_LL{}       	  = 2
@@ -246,7 +246,7 @@ bciStackUse PUSH_PRIMOP{}         = 1
 bciStackUse PUSH_BCO{}    	  = 1
 bciStackUse (PUSH_ALTS bco)       = 2 + protoBCOStackUse bco
 bciStackUse (PUSH_ALTS_UNLIFTED bco _) = 2 + protoBCOStackUse bco
-bciStackUse (PUSH_UBX _ nw)       = nw
+bciStackUse (PUSH_UBX _ nw)       = fromIntegral nw
 bciStackUse PUSH_APPLY_N{}	  = 1
 bciStackUse PUSH_APPLY_V{}	  = 1
 bciStackUse PUSH_APPLY_F{}	  = 1
@@ -261,7 +261,7 @@ bciStackUse PUSH_APPLY_PPPPPP{}	  = 1
 bciStackUse ALLOC_AP{}            = 1
 bciStackUse ALLOC_AP_NOUPD{}      = 1
 bciStackUse ALLOC_PAP{}           = 1
-bciStackUse (UNPACK sz)           = sz
+bciStackUse (UNPACK sz)           = fromIntegral sz
 bciStackUse LABEL{}       	  = 0
 bciStackUse TESTLT_I{}     	  = 0
 bciStackUse TESTEQ_I{}     	  = 0
diff --git a/compiler/ghci/ByteCodeLink.lhs b/compiler/ghci/ByteCodeLink.lhs
index 5e39fdef10..11d4022196 100644
--- a/compiler/ghci/ByteCodeLink.lhs
+++ b/compiler/ghci/ByteCodeLink.lhs
@@ -50,6 +50,8 @@ import GHC.Arr		( Array(..) )
 import GHC.IOBase	( IO(..) )
 import GHC.Ptr		( Ptr(..), castPtr )
 import GHC.Base		( writeArray#, RealWorld, Int(..), Word# )  
+
+import Data.Word
 \end{code}
 
 
@@ -123,7 +125,7 @@ linkBCO' ie ce (UnlinkedBCO nm arity insns_barr bitmap literalsSS ptrsSS)
             !ptrs_parr = case ptrs_arr of Array _lo _hi _n parr -> parr
 
             literals_arr = listArray (0, n_literals-1) linked_literals
-                           :: UArray Int Word
+                           :: UArray Word16 Word
             !literals_barr = case literals_arr of UArray _lo _hi _n barr -> barr
 
 	    !(I# arity#)  = arity
@@ -132,7 +134,7 @@ linkBCO' ie ce (UnlinkedBCO nm arity insns_barr bitmap literalsSS ptrsSS)
 
 
 -- we recursively link any sub-BCOs while making the ptrs array
-mkPtrsArray :: ItblEnv -> ClosureEnv -> Int -> [BCOPtr] -> IO (Array Int HValue)
+mkPtrsArray :: ItblEnv -> ClosureEnv -> Word16 -> [BCOPtr] -> IO (Array Word16 HValue)
 mkPtrsArray ie ce n_ptrs ptrs = do
   marr <- newArray_ (0, n_ptrs-1)
   let 
@@ -165,7 +167,7 @@ instance MArray IOArray e IO where
     unsafeWrite (IOArray marr) i e = stToIO (unsafeWrite marr i e)
 
 -- XXX HACK: we should really have a new writeArray# primop that takes a BCO#.
-writeArrayBCO :: IOArray Int a -> Int -> BCO# -> IO ()
+writeArrayBCO :: IOArray Word16 a -> Int -> BCO# -> IO ()
 writeArrayBCO (IOArray (STArray _ _ _ marr#)) (I# i#) bco# = IO $ \s# ->
   case (unsafeCoerce# writeArray#) marr# i# bco# s# of { s# ->
   (# s#, () #) }
diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs
index 33227a8cd8..352fbf055f 100644
--- a/compiler/main/InteractiveEval.hs
+++ b/compiler/main/InteractiveEval.hs
@@ -586,7 +586,7 @@ bindLocalsAtBreakpoint hsc_env apStack (Just info) = do
    -- has been accidentally evaluated, or something else has gone wrong.
    -- So that we don't fall over in a heap when this happens, just don't
    -- bind any free variables instead, and we emit a warning.
-   mb_hValues <- mapM (getIdValFromApStack apStack) offsets
+   mb_hValues <- mapM (getIdValFromApStack apStack) (map fromIntegral offsets)
    let filtered_ids = [ id | (id, Just _hv) <- zip ids mb_hValues ]
    when (any isNothing mb_hValues) $
       debugTraceMsg (hsc_dflags hsc_env) 1 $
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index fc5a87ee29..34ee673ad1 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -501,6 +501,9 @@ instance Outputable Word16 where
 instance Outputable Word32 where
    ppr n = integer $ fromIntegral n
 
+instance Outputable Word where
+   ppr n = integer $ fromIntegral n
+
 instance Outputable () where
    ppr _ = text "()"