Merge remote-tracking branch 'origin/master' into tc-untouchables

Conflicts:
	compiler/typecheck/TcMType.lhs
	compiler/typecheck/TcSMonad.lhs

1 files changed, 47 insertions, 42 deletions

diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs
index 9443e0e936..45edd64666 100644
--- a/compiler/codeGen/CgCallConv.hs
+++ b/compiler/codeGen/CgCallConv.hs
@@ -34,7 +34,6 @@ import SMRep
 import OldCmm
 import CLabel
 
-import Constants
 import CgStackery
 import ClosureInfo( CgRep(..), nonVoidArg, idCgRep, cgRepSizeW, isFollowableArg )
 import OldCmmUtils
@@ -67,18 +66,18 @@ import Data.Bits
 -------------------------
 mkArgDescr :: Name -> [Id] -> FCode ArgDescr
 mkArgDescr _nm args
-  = case stdPattern arg_reps of
-        Just spec_id -> return (ArgSpec spec_id)
-        Nothing      -> return (ArgGen arg_bits)
-  where
-    arg_bits = argBits arg_reps
-    arg_reps = filter nonVoidArg (map idCgRep args)
-        -- Getting rid of voids eases matching of standard patterns
-
-argBits :: [CgRep] -> [Bool]    -- True for non-ptr, False for ptr
-argBits []              = []
-argBits (PtrArg : args) = False : argBits args
-argBits (arg    : args) = take (cgRepSizeW arg) (repeat True) ++ argBits args
+  = do dflags <- getDynFlags
+       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
+           Just spec_id -> return (ArgSpec spec_id)
+           Nothing      -> return (ArgGen arg_bits)
+
+argBits :: DynFlags -> [CgRep] -> [Bool]    -- True for non-ptr, False for ptr
+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
@@ -226,8 +225,9 @@ getSequelAmode :: FCode CmmExpr
 getSequelAmode
   = do  { EndOfBlockInfo virt_sp sequel <- getEndOfBlockInfo
         ; case sequel of
-            OnStack -> do { sp_rel <- getSpRelOffset virt_sp
-                          ; returnFC (CmmLoad sp_rel bWord) }
+            OnStack -> do { dflags <- getDynFlags
+                          ; sp_rel <- getSpRelOffset virt_sp
+                          ; returnFC (CmmLoad sp_rel (bWord dflags)) }
 
             CaseAlts lbl _ _  -> returnFC (CmmLit (CmmLabel lbl))
         }
@@ -263,7 +263,7 @@ type AssignRegs a = [(CgRep,a)]          -- Arg or result values to assign
                      [(CgRep,a)])        -- Leftover arg or result values
 
 assignCallRegs       :: DynFlags -> AssignRegs a
-assignPrimOpCallRegs ::             AssignRegs a
+assignPrimOpCallRegs :: DynFlags -> AssignRegs a
 assignReturnRegs     :: DynFlags -> AssignRegs a
 
 assignCallRegs dflags args
@@ -272,8 +272,8 @@ assignCallRegs dflags args
         -- never uses Node for argument passing; instead
         -- Node points to the function closure itself
 
-assignPrimOpCallRegs args
- = assign_regs args (mkRegTbl_allRegs [])
+assignPrimOpCallRegs dflags args
+ = assign_regs args (mkRegTbl_allRegs dflags [])
         -- For primops, *all* arguments must be passed in registers
 
 assignReturnRegs dflags args
@@ -333,19 +333,19 @@ assign_reg _         _                  = Nothing
 useVanillaRegs :: DynFlags -> Int
 useVanillaRegs dflags
  | platformUnregisterised (targetPlatform dflags) = 0
- | otherwise                                      = mAX_Real_Vanilla_REG
+ | otherwise                                      = mAX_Real_Vanilla_REG dflags
 useFloatRegs :: DynFlags -> Int
 useFloatRegs dflags
  | platformUnregisterised (targetPlatform dflags) = 0
- | otherwise                                      = mAX_Real_Float_REG
+ | otherwise                                      = mAX_Real_Float_REG dflags
 useDoubleRegs :: DynFlags -> Int
 useDoubleRegs dflags
  | platformUnregisterised (targetPlatform dflags) = 0
- | otherwise                                      = mAX_Real_Double_REG
+ | otherwise                                      = mAX_Real_Double_REG dflags
 useLongRegs :: DynFlags -> Int
 useLongRegs dflags
  | platformUnregisterised (targetPlatform dflags) = 0
- | otherwise                                      = mAX_Real_Long_REG
+ | otherwise                                      = mAX_Real_Long_REG dflags
 
 vanillaRegNos, floatRegNos, doubleRegNos, longRegNos :: DynFlags -> [Int]
 vanillaRegNos dflags = regList $ useVanillaRegs dflags
@@ -353,11 +353,12 @@ floatRegNos   dflags = regList $ useFloatRegs   dflags
 doubleRegNos  dflags = regList $ useDoubleRegs  dflags
 longRegNos    dflags = regList $ useLongRegs    dflags
 
-allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos :: [Int]
-allVanillaRegNos = regList mAX_Vanilla_REG
-allFloatRegNos   = regList mAX_Float_REG
-allDoubleRegNos  = regList mAX_Double_REG
-allLongRegNos    = regList mAX_Long_REG
+allVanillaRegNos, allFloatRegNos, allDoubleRegNos, allLongRegNos
+    :: DynFlags -> [Int]
+allVanillaRegNos dflags = regList $ mAX_Vanilla_REG dflags
+allFloatRegNos   dflags = regList $ mAX_Float_REG   dflags
+allDoubleRegNos  dflags = regList $ mAX_Double_REG  dflags
+allLongRegNos    dflags = regList $ mAX_Long_REG    dflags
 
 regList :: Int -> [Int]
 regList n = [1 .. n]
@@ -370,25 +371,29 @@ type AvailRegs = ( [Int]   -- available vanilla regs.
 
 mkRegTbl :: DynFlags -> [GlobalReg] -> AvailRegs
 mkRegTbl dflags regs_in_use
-  = mkRegTbl' regs_in_use (vanillaRegNos dflags)
-                          (floatRegNos   dflags)
-                          (doubleRegNos  dflags)
-                          (longRegNos    dflags)
-
-mkRegTbl_allRegs :: [GlobalReg] -> AvailRegs
-mkRegTbl_allRegs regs_in_use
-  = mkRegTbl' regs_in_use allVanillaRegNos allFloatRegNos allDoubleRegNos allLongRegNos
-
-mkRegTbl' :: [GlobalReg] -> [Int] -> [Int] -> [Int] -> [Int]
+  = mkRegTbl' dflags regs_in_use
+              vanillaRegNos floatRegNos doubleRegNos longRegNos
+
+mkRegTbl_allRegs :: DynFlags -> [GlobalReg] -> AvailRegs
+mkRegTbl_allRegs dflags regs_in_use
+  = mkRegTbl' dflags regs_in_use
+              allVanillaRegNos allFloatRegNos allDoubleRegNos allLongRegNos
+
+mkRegTbl' :: DynFlags -> [GlobalReg]
+          -> (DynFlags -> [Int])
+          -> (DynFlags -> [Int])
+          -> (DynFlags -> [Int])
+          -> (DynFlags -> [Int])
           -> ([Int], [Int], [Int], [Int])
-mkRegTbl' regs_in_use vanillas floats doubles longs
+mkRegTbl' dflags regs_in_use vanillas floats doubles longs
   = (ok_vanilla, ok_float, ok_double, ok_long)
   where
-    ok_vanilla = mapCatMaybes (select (\i -> VanillaReg i VNonGcPtr)) vanillas
+    ok_vanilla = mapCatMaybes (select (\i -> VanillaReg i VNonGcPtr))
+                              (vanillas dflags)
                     -- ptrhood isn't looked at, hence we can use any old rep.
-    ok_float   = mapCatMaybes (select FloatReg)   floats
-    ok_double  = mapCatMaybes (select DoubleReg)  doubles
-    ok_long    = mapCatMaybes (select LongReg)    longs
+    ok_float   = mapCatMaybes (select FloatReg)  (floats  dflags)
+    ok_double  = mapCatMaybes (select DoubleReg) (doubles dflags)
+    ok_long    = mapCatMaybes (select LongReg)   (longs   dflags)
 
     select :: (Int -> GlobalReg) -> Int{-cand-} -> Maybe Int
         -- one we've unboxed the Int, we make a GlobalReg