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

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

1 files changed, 21 insertions, 21 deletions

diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs
index 4c451ec339..aeb87235e3 100644
--- a/compiler/codeGen/CgCon.lhs
+++ b/compiler/codeGen/CgCon.lhs
@@ -36,7 +36,6 @@ import OldCmmUtils
 import OldCmm
 import SMRep
 import CostCentre
-import Constants
 import TyCon
 import DataCon
 import Id
@@ -99,7 +98,7 @@ cgTopRhsCon id con args
         ; emitDataLits closure_label closure_rep
 
                 -- RETURN
-        ; returnFC (id, taggedStableIdInfo id (mkLblExpr closure_label) lf_info con) }
+        ; returnFC (id, taggedStableIdInfo dflags id (mkLblExpr closure_label) lf_info con) }
 \end{code}
 
 %************************************************************************
@@ -149,8 +148,8 @@ which have exclusively size-zero (VoidRep) args, we generate no code
 at all.
 
 \begin{code}
-buildDynCon' _ _ binder _ con []
-  = returnFC (taggedStableIdInfo binder
+buildDynCon' dflags _ binder _ con []
+  = returnFC (taggedStableIdInfo dflags binder
                            (mkLblExpr (mkClosureLabel (dataConName con)
                                       (idCafInfo binder)))
                            (mkConLFInfo con)
@@ -189,24 +188,24 @@ buildDynCon' dflags platform binder _ con [arg_amode]
   , platformOS platform /= OSMinGW32 || not (dopt Opt_PIC dflags)
   , (_, CmmLit (CmmInt val _)) <- arg_amode
   , let val_int = (fromIntegral val) :: Int
-  , val_int <= mAX_INTLIKE && val_int >= mIN_INTLIKE
+  , val_int <= mAX_INTLIKE dflags && val_int >= mIN_INTLIKE dflags
   = do  { let intlike_lbl   = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_INTLIKE_closure")
-              offsetW = (val_int - mIN_INTLIKE) * (fixedHdrSize dflags + 1)
+              offsetW = (val_int - mIN_INTLIKE dflags) * (fixedHdrSize dflags + 1)
                 -- INTLIKE closures consist of a header and one word payload
-              intlike_amode = CmmLit (cmmLabelOffW intlike_lbl offsetW)
-        ; returnFC (taggedStableIdInfo binder intlike_amode (mkConLFInfo con) con) }
+              intlike_amode = CmmLit (cmmLabelOffW dflags intlike_lbl offsetW)
+        ; returnFC (taggedStableIdInfo dflags binder intlike_amode (mkConLFInfo con) con) }
 
 buildDynCon' dflags platform binder _ con [arg_amode]
   | maybeCharLikeCon con
   , platformOS platform /= OSMinGW32 || not (dopt Opt_PIC dflags)
   , (_, CmmLit (CmmInt val _)) <- arg_amode
   , let val_int = (fromIntegral val) :: Int
-  , val_int <= mAX_CHARLIKE && val_int >= mIN_CHARLIKE
+  , val_int <= mAX_CHARLIKE dflags && val_int >= mIN_CHARLIKE dflags
   = do  { let charlike_lbl   = mkCmmGcPtrLabel rtsPackageId (fsLit "stg_CHARLIKE_closure")
-              offsetW = (val_int - mIN_CHARLIKE) * (fixedHdrSize dflags + 1)
+              offsetW = (val_int - mIN_CHARLIKE dflags) * (fixedHdrSize dflags + 1)
                 -- CHARLIKE closures consist of a header and one word payload
-              charlike_amode = CmmLit (cmmLabelOffW charlike_lbl offsetW)
-        ; returnFC (taggedStableIdInfo binder charlike_amode (mkConLFInfo con) con) }
+              charlike_amode = CmmLit (cmmLabelOffW dflags charlike_lbl offsetW)
+        ; returnFC (taggedStableIdInfo dflags binder charlike_amode (mkConLFInfo con) con) }
 
 \end{code}
 
@@ -219,7 +218,7 @@ buildDynCon' dflags _ binder ccs con args
             (closure_info, amodes_w_offsets) = layOutDynConstr dflags con args
 
         ; hp_off <- allocDynClosure closure_info use_cc blame_cc amodes_w_offsets
-        ; returnFC (taggedHeapIdInfo binder hp_off lf_info con) }
+        ; returnFC (taggedHeapIdInfo dflags binder hp_off lf_info con) }
   where
     lf_info = mkConLFInfo con
 
@@ -250,7 +249,7 @@ bindConArgs con args
        let
           -- The binding below forces the masking out of the tag bits
           -- when accessing the constructor field.
-          bind_arg (arg, offset) = bindNewToUntagNode arg offset (mkLFArgument arg) (tagForCon con)
+          bind_arg (arg, offset) = bindNewToUntagNode arg offset (mkLFArgument arg) (tagForCon dflags con)
           (_, args_w_offsets)    = layOutDynConstr dflags con (addIdReps args)
         --
        ASSERT(not (isUnboxedTupleCon con)) return ()
@@ -285,8 +284,8 @@ bindUnboxedTupleComponents args
                 -- Allocate the rest on the stack
                 -- The real SP points to the return address, above which any
                 -- leftover unboxed-tuple components will be allocated
-              (ptr_sp,  ptr_offsets)  = mkVirtStkOffsets rsp    ptr_args
-              (nptr_sp, nptr_offsets) = mkVirtStkOffsets ptr_sp nptr_args
+              (ptr_sp,  ptr_offsets)  = mkVirtStkOffsets dflags rsp    ptr_args
+              (nptr_sp, nptr_offsets) = mkVirtStkOffsets dflags ptr_sp nptr_args
               ptrs  = ptr_sp  - rsp
               nptrs = nptr_sp - ptr_sp
 
@@ -355,8 +354,8 @@ cgReturnDataCon con amodes = do
   where
     node_live   = Just [node]
     enter_it dflags
-                = stmtsC [ CmmAssign nodeReg (cmmUntag (CmmReg nodeReg)),
-                           CmmJump (entryCode dflags $ closureInfoPtr $ CmmReg nodeReg)
+                = stmtsC [ CmmAssign nodeReg (cmmUntag dflags (CmmReg nodeReg)),
+                           CmmJump (entryCode dflags $ closureInfoPtr dflags $ CmmReg nodeReg)
                                    node_live
                          ]
     jump_to lbl = stmtC $ CmmJump (CmmLit lbl) node_live
@@ -419,7 +418,8 @@ closures predeclared.
 \begin{code}
 cgTyCon :: TyCon -> FCode CmmGroup  -- each constructor gets a separate CmmGroup
 cgTyCon tycon
-  = do  { constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
+  = do  { dflags <- getDynFlags
+        ; constrs <- mapM (getCmm . cgDataCon) (tyConDataCons tycon)
 
             -- Generate a table of static closures for an enumeration type
             -- Put the table after the data constructor decls, because the
@@ -432,7 +432,7 @@ cgTyCon tycon
         ; extra <-
            if isEnumerationTyCon tycon then do
                 tbl <- getCmm (emitRODataLits "cgTyCon" (mkLocalClosureTableLabel (tyConName tycon) NoCafRefs)
-                           [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs) (tagForCon con)
+                           [ CmmLabelOff (mkLocalClosureLabel (dataConName con) NoCafRefs) (tagForCon dflags con)
                            | con <- tyConDataCons tycon])
                 return [tbl]
            else
@@ -478,7 +478,7 @@ cgDataCon data_con
                              tickyReturnOldCon (length arg_things)
                            -- The case continuation code is expecting a tagged pointer
                            ; stmtC (CmmAssign nodeReg
-                                              (tagCons data_con (CmmReg nodeReg)))
+                                              (tagCons dflags data_con (CmmReg nodeReg)))
                            ; performReturn $ emitReturnInstr (Just []) }
                                 -- noStmts: Ptr to thing already in Node