change CmmActual, CmmFormal to use a data CmmHinted rather than tuple (#1405)

This allows the instance of UserOfLocalRegs to be within Haskell98, and IMHO
 makes the code a little cleaner generally.
This is one small (though tedious) step towards making GHC's code more
 portable...

23 files changed, 125 insertions, 112 deletions

diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs
index 790d072293..3fd5e441a6 100644
--- a/compiler/cmm/Cmm.hs
+++ b/compiler/cmm/Cmm.hs
@@ -18,6 +18,7 @@ module Cmm (
         CmmReturnInfo(..),
 	CmmStmt(..), CmmActual, CmmActuals, CmmFormal, CmmFormals, CmmKind,
         CmmFormalsWithoutKinds, CmmFormalWithoutKind,
+        CmmHinted(..),
         CmmSafety(..),
 	CmmCallTarget(..),
 	CmmStatic(..), Section(..),
@@ -240,8 +241,10 @@ data CmmStmt
       CmmActuals         -- with these return values.
 
 type CmmKind   = MachHint
-type CmmActual = (CmmExpr, CmmKind)
-type CmmFormal = (LocalReg,CmmKind)
+data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: CmmKind }
+                         deriving (Eq)
+type CmmActual = CmmHinted CmmExpr
+type CmmFormal = CmmHinted LocalReg
 type CmmActuals = [CmmActual]
 type CmmFormals = [CmmFormal]
 type CmmFormalWithoutKind   = LocalReg
@@ -250,8 +253,8 @@ type CmmFormalsWithoutKinds = [CmmFormalWithoutKind]
 data CmmSafety      = CmmUnsafe | CmmSafe C_SRT
 
 -- | enable us to fold used registers over 'CmmActuals' and 'CmmFormals'
-instance UserOfLocalRegs a => UserOfLocalRegs (a, CmmKind) where
-  foldRegsUsed f set (a, _) = foldRegsUsed f set a
+instance UserOfLocalRegs a => UserOfLocalRegs (CmmHinted a) where
+  foldRegsUsed f set (CmmHinted a _) = foldRegsUsed f set a
 
 instance UserOfLocalRegs CmmStmt where
   foldRegsUsed f set s = stmt s set
@@ -271,6 +274,11 @@ instance UserOfLocalRegs CmmCallTarget where
     foldRegsUsed f set (CmmCallee e _) = foldRegsUsed f set e
     foldRegsUsed _ set (CmmPrim {})    = set
 
+--just look like a tuple, since it was a tuple before
+-- ... is that a good idea? --Isaac Dupree
+instance (Outputable a) => Outputable (CmmHinted a) where
+  ppr (CmmHinted a k) = ppr (a, k)
+
 {-
 Discussion
 ~~~~~~~~~~
diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs
index 98a6c3b391..20a4a8c85e 100644
--- a/compiler/cmm/CmmBrokenBlock.hs
+++ b/compiler/cmm/CmmBrokenBlock.hs
@@ -348,7 +348,7 @@ makeContinuationEntries formats
     case lookup ident formats of
       Nothing -> block
       Just (ContFormat formals srt is_gc) ->
-          BrokenBlock ident (ContinuationEntry (map fst formals) srt is_gc)
+          BrokenBlock ident (ContinuationEntry (map hintlessCmm formals) srt is_gc)
                       stmts targets exit
 
 adaptBlockToFormat :: [(BlockId, ContFormat)]
@@ -378,7 +378,7 @@ adaptBlockToFormat formats unique
                        target formals actuals srt ret is_gc
 
       adaptor_block = mk_adaptor_block adaptor_ident
-                  (ContinuationEntry (map fst formals) srt is_gc)
+                  (ContinuationEntry (map hintlessCmm formals) srt is_gc)
                   next format_formals
       adaptor_ident = BlockId unique
 
@@ -390,7 +390,8 @@ adaptBlockToFormat formats unique
                          (CmmLit (CmmLabel (mkReturnPtLabel (getUnique next))))
                          (map formal_to_actual format_formals)
 
-                formal_to_actual (reg, hint) = ((CmmReg (CmmLocal reg)), hint)
+                formal_to_actual (CmmHinted reg hint)
+                     = (CmmHinted (CmmReg (CmmLocal reg)) hint)
                 -- TODO: Check if NoHint is right.  We're
                 -- jumping to a C-- function not a foreign one
                 -- so it might always be right.
diff --git a/compiler/cmm/CmmCPS.hs b/compiler/cmm/CmmCPS.hs
index 25f30a8951..5a7998192b 100644
--- a/compiler/cmm/CmmCPS.hs
+++ b/compiler/cmm/CmmCPS.hs
@@ -359,14 +359,14 @@ continuationMaxStack formats (Continuation _ label _ False blocks) =
                    map stmt_arg_size (brokenBlockStmts block))
 
       final_arg_size (FinalReturn args) =
-          argumentsSize (cmmExprRep . fst) args
+          argumentsSize (cmmExprRep . hintlessCmm) args
       final_arg_size (FinalJump _ args) =
-          argumentsSize (cmmExprRep . fst) args
+          argumentsSize (cmmExprRep . hintlessCmm) args
       final_arg_size (FinalCall next _ _ args _ _ True) = 0
       final_arg_size (FinalCall next _ _ args _ _ False) =
           -- We have to account for the stack used when we build a frame
           -- for the *next* continuation from *this* continuation
-          argumentsSize (cmmExprRep . fst) args +
+          argumentsSize (cmmExprRep . hintlessCmm) args +
           continuation_frame_size next_format
           where 
             next_format = maybe unknown_format id $ lookup next' formats
@@ -375,7 +375,7 @@ continuationMaxStack formats (Continuation _ label _ False blocks) =
       final_arg_size _ = 0
 
       stmt_arg_size (CmmJump _ args) =
-          argumentsSize (cmmExprRep . fst) args
+          argumentsSize (cmmExprRep . hintlessCmm) args
       stmt_arg_size (CmmCall _ _ _ (CmmSafe _) _) =
           panic "Safe call in processFormats"
       stmt_arg_size (CmmReturn _) =
diff --git a/compiler/cmm/CmmCPSGen.hs b/compiler/cmm/CmmCPSGen.hs
index 94d4b7bdfb..55a7397a68 100644
--- a/compiler/cmm/CmmCPSGen.hs
+++ b/compiler/cmm/CmmCPSGen.hs
@@ -228,7 +228,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques
                                 foreignCall call_uniques (CmmPrim target)
                                             results arguments
 
-formal_to_actual reg = (CmmReg (CmmLocal reg), NoHint)
+formal_to_actual reg = CmmHinted (CmmReg (CmmLocal reg)) NoHint
 
 foreignCall :: [Unique] -> CmmCallTarget -> CmmFormals -> CmmActuals -> [CmmStmt]
 foreignCall uniques call results arguments =
@@ -236,14 +236,14 @@ foreignCall uniques call results arguments =
     saveThreadState ++
     caller_save ++
     [CmmCall (CmmCallee suspendThread CCallConv)
-		 [ (id,PtrHint) ]
-		 [ (CmmReg (CmmGlobal BaseReg), PtrHint) ]
+		 [ CmmHinted id PtrHint ]
+		 [ CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint ]
 		 CmmUnsafe
                  CmmMayReturn,
      CmmCall call results new_args CmmUnsafe CmmMayReturn,
      CmmCall (CmmCallee resumeThread CCallConv)
-                 [ (new_base, PtrHint) ]
-		 [ (CmmReg (CmmLocal id), PtrHint) ]
+                 [ CmmHinted new_base PtrHint ]
+		 [ CmmHinted (CmmReg (CmmLocal id)) PtrHint ]
 		 CmmUnsafe
                  CmmMayReturn,
      -- Assign the result to BaseReg: we
@@ -251,7 +251,7 @@ foreignCall uniques call results arguments =
      CmmAssign (CmmGlobal BaseReg) (CmmReg (CmmLocal new_base))] ++
     caller_load ++
     loadThreadState tso_unique ++
-    [CmmJump (CmmReg spReg) (map (formal_to_actual . fst) results)]
+    [CmmJump (CmmReg spReg) (map (formal_to_actual . hintlessCmm) results)]
     where
       (_, arg_stmts, new_args) =
           loadArgsIntoTemps argument_uniques arguments
@@ -363,12 +363,12 @@ tail_call spRel target arguments
   = store_arguments ++ adjust_sp_reg spRel ++ jump where
     store_arguments =
         [stack_put spRel expr offset
-         | ((expr, _), StackParam offset) <- argument_formats] ++
+         | ((CmmHinted expr _), StackParam offset) <- argument_formats] ++
         [global_put expr global
-         | ((expr, _), RegisterParam global) <- argument_formats]
+         | ((CmmHinted expr _), RegisterParam global) <- argument_formats]
     jump = [CmmJump target arguments]
 
-    argument_formats = assignArguments (cmmExprRep . fst) arguments
+    argument_formats = assignArguments (cmmExprRep . hintlessCmm) arguments
 
 adjust_sp_reg spRel =
     if spRel == 0
diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs
index b1922d0cac..e376e56d47 100644
--- a/compiler/cmm/CmmLint.hs
+++ b/compiler/cmm/CmmLint.hs
@@ -137,7 +137,7 @@ lintCmmStmt labels = lint
             lintCmmExpr r
             return ()
           lint (CmmCall target _res args _ _) =
-              lintTarget target >> mapM_ (lintCmmExpr.fst) args
+              lintTarget target >> mapM_ (lintCmmExpr . hintlessCmm) args
           lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr e >> checkCond e
           lint (CmmSwitch e branches) = do
             mapM_ checkTarget $ catMaybes branches
@@ -145,8 +145,8 @@ lintCmmStmt labels = lint
             if (erep == wordRep)
               then return ()
               else cmmLintErr (text "switch scrutinee is not a word: " <> ppr e)
-          lint (CmmJump e args) = lintCmmExpr e >> mapM_ (lintCmmExpr.fst) args
-          lint (CmmReturn ress) = mapM_ (lintCmmExpr.fst) ress
+          lint (CmmJump e args) = lintCmmExpr e >> mapM_ (lintCmmExpr . hintlessCmm) args
+          lint (CmmReturn ress) = mapM_ (lintCmmExpr . hintlessCmm) ress
           lint (CmmBranch id)    = checkTarget id
           checkTarget id = if elemBlockSet id labels then return ()
                            else cmmLintErr (text "Branch to nonexistent id" <+> ppr id)
diff --git a/compiler/cmm/CmmLive.hs b/compiler/cmm/CmmLive.hs
index 4450192824..f9973deb56 100644
--- a/compiler/cmm/CmmLive.hs
+++ b/compiler/cmm/CmmLive.hs
@@ -164,7 +164,7 @@ addKilled new_killed live = live `minusUniqSet` new_killed
 -- Liveness of a CmmStmt
 --------------------------------
 cmmFormalsToLiveLocals :: CmmFormals -> [LocalReg]
-cmmFormalsToLiveLocals formals = map fst formals
+cmmFormalsToLiveLocals formals = map hintlessCmm formals
 
 cmmStmtLive :: BlockEntryLiveness -> CmmStmt -> CmmLivenessTransformer
 cmmStmtLive _ (CmmNop) = id
@@ -179,7 +179,7 @@ cmmStmtLive _ (CmmStore expr1 expr2) =
     cmmExprLive expr2 . cmmExprLive expr1
 cmmStmtLive _ (CmmCall target results arguments _ _) =
     target_liveness .
-    foldr ((.) . cmmExprLive) id (map fst arguments) .
+    foldr ((.) . cmmExprLive) id (map hintlessCmm arguments) .
     addKilled (mkUniqSet $ cmmFormalsToLiveLocals results) where
         target_liveness =
             case target of
@@ -197,9 +197,9 @@ cmmStmtLive other_live (CmmSwitch expr targets) =
            id
            (mapCatMaybes id targets))
 cmmStmtLive _ (CmmJump expr params) =
-    const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
+    const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet)
 cmmStmtLive _ (CmmReturn params) =
-    const (foldr ((.) . cmmExprLive) id (map fst params) $ emptyUniqSet)
+    const (foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet)
 
 --------------------------------
 -- Liveness of a CmmExpr
diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs
index b96aa4aa89..c906050a1b 100644
--- a/compiler/cmm/CmmOpt.hs
+++ b/compiler/cmm/CmmOpt.hs
@@ -156,7 +156,7 @@ inlineStmt u a (CmmCall target regs es srt ret)
    = CmmCall (infn target) regs es' srt ret
    where infn (CmmCallee fn cconv) = CmmCallee fn cconv
 	 infn (CmmPrim p) = CmmPrim p
-	 es' = [ (inlineExpr u a e, hint) | (e,hint) <- es ]
+	 es' = [ (CmmHinted (inlineExpr u a e) hint) | (CmmHinted e hint) <- es ]
 inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
 inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
 inlineStmt u a (CmmJump e d) = CmmJump (inlineExpr u a e) d
diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y
index 2d74aeeb95..70cd7c4c5b 100644
--- a/compiler/cmm/CmmParse.y
+++ b/compiler/cmm/CmmParse.y
@@ -470,10 +470,10 @@ cmm_kind_exprs :: { [ExtFCode CmmActual] }
 	| cmm_kind_expr ',' cmm_kind_exprs	{ $1 : $3 }
 
 cmm_kind_expr :: { ExtFCode CmmActual }
-	: expr				{ do e <- $1; return (e, inferCmmKind e) }
+	: expr				{ do e <- $1; return (CmmHinted e (inferCmmKind e)) }
 	| expr STRING			{% do h <- parseCmmKind $2;
 					      return $ do
-						e <- $1; return (e,h) }
+						e <- $1; return (CmmHinted e h) }
 
 exprs0  :: { [ExtFCode CmmExpr] }
 	: {- empty -}			{ [] }
@@ -497,10 +497,10 @@ cmm_formals :: { [ExtFCode CmmFormal] }
 	| cmm_formal ',' cmm_formals	{ $1 : $3 }
 
 cmm_formal :: { ExtFCode CmmFormal }
-	: local_lreg			{ do e <- $1; return (e, inferCmmKind (CmmReg (CmmLocal e))) }
+	: local_lreg			{ do e <- $1; return (CmmHinted e (inferCmmKind (CmmReg (CmmLocal e)))) }
 	| STRING local_lreg		{% do h <- parseCmmKind $1;
 					      return $ do
-						e <- $2; return (e,h) }
+						e <- $2; return (CmmHinted e h) }
 
 local_lreg :: { ExtFCode LocalReg }
 	: NAME			{ do e <- lookupName $1;
@@ -921,13 +921,13 @@ foreignCall conv_string results_code expr_code args_code vols safety ret
                    (CmmCallee expr' convention) args vols NoC_SRT ret) where
 	        unused = panic "not used by emitForeignCall'"
 
-adjCallTarget :: CCallConv -> CmmExpr -> [(CmmExpr,MachHint)] -> CmmExpr
+adjCallTarget :: CCallConv -> CmmExpr -> [CmmHinted CmmExpr] -> CmmExpr
 #ifdef mingw32_TARGET_OS
 -- On Windows, we have to add the '@N' suffix to the label when making
 -- a call with the stdcall calling convention.
 adjCallTarget StdCallConv (CmmLit (CmmLabel lbl)) args
   = CmmLit (CmmLabel (addLabelSize lbl (sum (map size args))))
-  where size (e,_) = max wORD_SIZE (machRepByteWidth (cmmExprRep e))
+  where size (CmmHinted e _) = max wORD_SIZE (machRepByteWidth (cmmExprRep e))
                  -- c.f. CgForeignCall.emitForeignCall
 #endif
 adjCallTarget _ expr _
diff --git a/compiler/cmm/CmmProcPointZ.hs b/compiler/cmm/CmmProcPointZ.hs
index b2dbd871c8..059b5f29ff 100644
--- a/compiler/cmm/CmmProcPointZ.hs
+++ b/compiler/cmm/CmmProcPointZ.hs
@@ -256,7 +256,7 @@ addProcPointProtocols procPoints formals g =
           maybe_add_proto (Block id _) env | id == lg_entry g =
               extendBlockEnv env id (Protocol stdArgConvention hinted_formals)
           maybe_add_proto _ env = env
-          hinted_formals = map (\x -> (x, NoHint)) formals
+          hinted_formals = map (\x -> CmmHinted x NoHint) formals
           stdArgConvention = ConventionStandard CmmCallConv Arguments
 
 -- | For now, following a suggestion by Ben Lippmeier, we pass all
@@ -279,7 +279,7 @@ pass_live_vars_as_args procPoints (protos, g) = (protos', g')
               Nothing -> let live = lookupBlockEnv liveness id `orElse`
                                     emptyRegSet -- XXX there's a bug lurking!
                                     -- panic ("no liveness at block " ++ show id)
-                             formals = map (\x->(x,NoHint)) $ uniqSetToList live
+                             formals = map (\x -> CmmHinted x NoHint) $ uniqSetToList live
                          in  extendBlockEnv protos id (Protocol ConventionPrivate formals)
         g' = g { lg_blocks = add_CopyIns protos' (lg_blocks g) }
 
diff --git a/compiler/cmm/CmmUtils.hs b/compiler/cmm/CmmUtils.hs
index 68c2eda7bf..675d44b716 100644
--- a/compiler/cmm/CmmUtils.hs
+++ b/compiler/cmm/CmmUtils.hs
@@ -196,10 +196,10 @@ loadArgsIntoTemps :: [Unique]
                   -> CmmActuals
                   -> ([Unique], [CmmStmt], CmmActuals)
 loadArgsIntoTemps uniques [] = (uniques, [], [])
-loadArgsIntoTemps uniques ((e, hint):args) =
+loadArgsIntoTemps uniques ((CmmHinted e hint):args) =
     (uniques'',
      new_stmts ++ remaining_stmts,
-     (new_e, hint) : remaining_e)
+     (CmmHinted new_e hint) : remaining_e)
     where
       (uniques', new_stmts, new_e) = maybeAssignTemp uniques e
       (uniques'', remaining_stmts, remaining_e) =
diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index c7d0cf16c1..ec70d0489a 100644
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -245,9 +245,9 @@ pprCFunType cconv ress args
    ]
   where
 	res_type [] = ptext SLIT("void")
-	res_type [(one,hint)] = machRepHintCType (localRegRep one) hint
+	res_type [CmmHinted one hint] = machRepHintCType (localRegRep one) hint
 
-	arg_type (expr,hint) = machRepHintCType (cmmExprRep expr) hint
+	arg_type (CmmHinted expr hint) = machRepHintCType (cmmExprRep expr) hint
 
 -- ---------------------------------------------------------------------
 -- unconditional branches
@@ -755,17 +755,17 @@ pprCall ppr_fn cconv results args _
     ppr_assign results (ppr_fn <> parens (commafy (map pprArg args))) <> semi
   where 
      ppr_assign []           rhs = rhs
-     ppr_assign [(one,hint)] rhs
+     ppr_assign [CmmHinted one hint] rhs
 	 = pprLocalReg one <> ptext SLIT(" = ")
 		 <> pprUnHint hint (localRegRep one) <> rhs
      ppr_assign _other _rhs = panic "pprCall: multiple results"
 
-     pprArg (expr, PtrHint)
+     pprArg (CmmHinted expr PtrHint)
    	= cCast (ptext SLIT("void *")) expr
 	-- see comment by machRepHintCType below
-     pprArg (expr, SignedHint)
+     pprArg (CmmHinted expr SignedHint)
 	= cCast (machRepSignedCType (cmmExprRep expr)) expr
-     pprArg (expr, _other)
+     pprArg (CmmHinted expr _other)
 	= pprExpr expr
 
      pprUnHint PtrHint    rep = parens (machRepCType rep)
@@ -849,8 +849,8 @@ te_Lit _ = return ()
 te_Stmt :: CmmStmt -> TE ()
 te_Stmt (CmmAssign r e)		= te_Reg r >> te_Expr e
 te_Stmt (CmmStore l r)		= te_Expr l >> te_Expr r
-te_Stmt (CmmCall _ rs es _ _)	= mapM_ (te_temp.fst) rs >>
-				  mapM_ (te_Expr.fst) es
+te_Stmt (CmmCall _ rs es _ _)	= mapM_ (te_temp.hintlessCmm) rs >>
+				  mapM_ (te_Expr.hintlessCmm) es
 te_Stmt (CmmCondBranch e _)	= te_Expr e
 te_Stmt (CmmSwitch e _)		= te_Expr e
 te_Stmt (CmmJump e _)		= te_Expr e
diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs
index 2aca16e9f6..43f39353af 100644
--- a/compiler/cmm/PprCmm.hs
+++ b/compiler/cmm/PprCmm.hs
@@ -284,7 +284,7 @@ genCondBranch expr ident =
 --
 --     jump foo(a, b, c);
 --
-genJump :: CmmExpr -> [(CmmExpr, MachHint)] -> SDoc
+genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc
 genJump expr args = 
 
     hcat [ ptext SLIT("jump")
@@ -298,18 +298,18 @@ genJump expr args =
          , parens  ( commafy $ map pprHinted args )
          , semi ]
 
-pprHinted :: Outputable a => (a, MachHint) -> SDoc
-pprHinted (a, NoHint)     = ppr a
-pprHinted (a, PtrHint)    = quotes(text "address") <+> ppr a
-pprHinted (a, SignedHint) = quotes(text "signed")  <+> ppr a
-pprHinted (a, FloatHint)  = quotes(text "float")   <+> ppr a
+pprHinted :: Outputable a => (CmmHinted a) -> SDoc
+pprHinted (CmmHinted a NoHint)     = ppr a
+pprHinted (CmmHinted a PtrHint)    = quotes(text "address") <+> ppr a
+pprHinted (CmmHinted a SignedHint) = quotes(text "signed")  <+> ppr a
+pprHinted (CmmHinted a FloatHint)  = quotes(text "float")   <+> ppr a
 
 -- --------------------------------------------------------------------------
 -- Return from a function. [1], Section 6.8.2 of version 1.128
 --
 --     return (a, b, c);
 --
-genReturn :: [(CmmExpr, MachHint)] -> SDoc
+genReturn :: [CmmHinted CmmExpr] -> SDoc
 genReturn args = 
 
     hcat [ ptext SLIT("return")
diff --git a/compiler/cmm/ZipCfgCmmRep.hs b/compiler/cmm/ZipCfgCmmRep.hs
index 0667b7e091..8c1b46156e 100644
--- a/compiler/cmm/ZipCfgCmmRep.hs
+++ b/compiler/cmm/ZipCfgCmmRep.hs
@@ -15,7 +15,7 @@ where
 
 import CmmExpr
 import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
-           , CmmCallTarget(..), CmmActuals, CmmFormals
+           , CmmCallTarget(..), CmmActuals, CmmFormals, CmmHinted(..)
            , CmmStmt(CmmSwitch) -- imported in order to call ppr
            )
 import PprCmm()
@@ -262,11 +262,11 @@ ppr_target t@(CmmLit _) = ppr t
 ppr_target fn'          = parens (ppr fn')
 
 
-pprHinted :: Outputable a => (a, MachHint) -> SDoc
-pprHinted (a, NoHint)     = ppr a
-pprHinted (a, PtrHint)    = doubleQuotes (text "address") <+> ppr a
-pprHinted (a, SignedHint) = doubleQuotes (text "signed")  <+> ppr a
-pprHinted (a, FloatHint)  = doubleQuotes (text "float")   <+> ppr a
+pprHinted :: Outputable a => CmmHinted a -> SDoc
+pprHinted (CmmHinted a NoHint)     = ppr a
+pprHinted (CmmHinted a PtrHint)    = doubleQuotes (text "address") <+> ppr a
+pprHinted (CmmHinted a SignedHint) = doubleQuotes (text "signed")  <+> ppr a
+pprHinted (CmmHinted a FloatHint)  = doubleQuotes (text "float")   <+> ppr a
 
 pprLast :: Last -> SDoc    
 pprLast stmt = (case stmt of
diff --git a/compiler/codeGen/CgCase.lhs b/compiler/codeGen/CgCase.lhs
index 398441e30c..beecceb209 100644
--- a/compiler/codeGen/CgCase.lhs
+++ b/compiler/codeGen/CgCase.lhs
@@ -165,7 +165,7 @@ cgCase (StgOpApp op@(StgFCallOp fcall _) args _)
 	-- exactly like the cgInlinePrimOp case for unboxed tuple alts..
 	{ res_tmps <- mapFCs bindNewToTemp non_void_res_ids
 	; let res_hints = map (typeHint.idType) non_void_res_ids
-	; cgForeignCall (zip res_tmps res_hints) fcall args live_in_alts
+	; cgForeignCall (zipWith CmmHinted res_tmps res_hints) fcall args live_in_alts
 	; cgExpr rhs }
   where
    (_, res_ids, _, rhs) = head alts
diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs
index 499442fdaa..b7360c8893 100644
--- a/compiler/codeGen/CgClosure.lhs
+++ b/compiler/codeGen/CgClosure.lhs
@@ -560,7 +560,7 @@ link_caf cl_info is_upd = do
 	-- so that the garbage collector can find them
 	-- This must be done *before* the info table pointer is overwritten, 
 	-- because the old info table ptr is needed for reversion
-  ; emitRtsCallWithVols SLIT("newCAF") [(CmmReg nodeReg,PtrHint)] [node] False
+  ; emitRtsCallWithVols SLIT("newCAF") [CmmHinted (CmmReg nodeReg) PtrHint] [node] False
 	-- node is live, so save it.
 
 	-- Overwrite the closure with a (static) indirection 
diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs
index bc91bef364..3f1ec45c77 100644
--- a/compiler/codeGen/CgExpr.lhs
+++ b/compiler/codeGen/CgExpr.lhs
@@ -133,13 +133,13 @@ cgExpr (StgOpApp (StgFCallOp fcall _) stg_args res_ty) = do
                  then assignPtrTemp arg
                  else assignNonPtrTemp arg
                      | (arg, stg_arg) <- arg_exprs]
-    let	arg_hints = zip arg_tmps (map (typeHint.stgArgType) stg_args)
+    let	arg_hints = zipWith CmmHinted arg_tmps (map (typeHint.stgArgType) stg_args)
     {-
 	Now, allocate some result regs.
     -}
     (res_reps,res_regs,res_hints)  <- newUnboxedTupleRegs res_ty
     ccallReturnUnboxedTuple (zip res_reps (map (CmmReg . CmmLocal) res_regs)) $
-	emitForeignCall (zip res_regs res_hints) fcall 
+	emitForeignCall (zipWith CmmHinted res_regs res_hints) fcall 
 	   arg_hints emptyVarSet{-no live vars-}
       
 -- tagToEnum# is special: we need to pull the constructor out of the table,
diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs
index fec1a8f058..8e1be19beb 100644
--- a/compiler/codeGen/CgForeignCall.hs
+++ b/compiler/codeGen/CgForeignCall.hs
@@ -64,7 +64,8 @@ cgForeignCall results fcall stg_args live
 	  	    | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes, 
 	               nonVoidArg rep]
 
-	arg_hints = zip arg_exprs (map (typeHint.stgArgType) stg_args)
+	arg_hints = zipWith CmmHinted
+                      arg_exprs (map (typeHint.stgArgType) stg_args)
   -- in
   emitForeignCall results fcall arg_hints live
 
@@ -72,7 +73,7 @@ cgForeignCall results fcall stg_args live
 emitForeignCall
 	:: CmmFormals	-- where to put the results
 	-> ForeignCall		-- the op
-	-> [(CmmExpr,MachHint)] -- arguments
+	-> [CmmHinted CmmExpr] -- arguments
 	-> StgLiveVars	-- live vars, in case we need to save them
 	-> Code
 
@@ -86,14 +87,14 @@ emitForeignCall results (CCall (CCallSpec target cconv safety)) args live
 	= case target of
 	   StaticTarget lbl -> (args, CmmLit (CmmLabel 
 					(mkForeignLabel lbl call_size False)))
-	   DynamicTarget    ->  case args of (fn,_):rest -> (rest, fn)
+	   DynamicTarget    ->  case args of (CmmHinted fn _):rest -> (rest, fn)
 
 	-- in the stdcall calling convention, the symbol needs @size appended
 	-- to it, where size is the total number of bytes of arguments.  We
 	-- attach this info to the CLabel here, and the CLabel pretty printer
 	-- will generate the suffix when the label is printed.
       call_size
-	| StdCallConv <- cconv = Just (sum (map (arg_size.cmmExprRep.fst) args))
+	| StdCallConv <- cconv = Just (sum (map (arg_size.cmmExprRep.hintlessCmm) args))
 	| otherwise            = Nothing
 
 	-- ToDo: this might not be correct for 64-bit API
@@ -108,7 +109,7 @@ emitForeignCall'
 	:: Safety
 	-> CmmFormals	-- where to put the results
 	-> CmmCallTarget	-- the op
-	-> [(CmmExpr,MachHint)] -- arguments
+	-> [CmmHinted CmmExpr] -- arguments
 	-> Maybe [GlobalReg]	-- live vars, in case we need to save them
         -> C_SRT                -- the SRT of the calls continuation
         -> CmmReturnInfo
@@ -137,13 +138,13 @@ emitForeignCall' safety results target args vols srt ret
     -- and the CPS will will be the one to convert that
     -- to this sequence of three CmmUnsafe calls.
     stmtC (CmmCall (CmmCallee suspendThread CCallConv) 
-			[ (id,PtrHint) ]
-			[ (CmmReg (CmmGlobal BaseReg), PtrHint) ] 
+			[ CmmHinted id PtrHint ]
+			[ CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint ] 
 			CmmUnsafe ret)
     stmtC (CmmCall temp_target results temp_args CmmUnsafe ret)
     stmtC (CmmCall (CmmCallee resumeThread CCallConv) 
-			[ (new_base, PtrHint) ]
-			[ (CmmReg (CmmLocal id), PtrHint) ]
+			[ CmmHinted new_base PtrHint ]
+			[ CmmHinted (CmmReg (CmmLocal id)) PtrHint ]
 			CmmUnsafe ret)
     -- Assign the result to BaseReg: we
     -- might now have a different Capability!
@@ -163,9 +164,9 @@ resumeThread  = CmmLit (CmmLabel (mkRtsCodeLabel SLIT("resumeThread")))
 -- This is a HACK; really it should be done in the back end, but
 -- it's easier to generate the temporaries here.
 load_args_into_temps = mapM arg_assign_temp
-  where arg_assign_temp (e,hint) = do
+  where arg_assign_temp (CmmHinted e hint) = do
 	   tmp <- maybe_assign_temp e
-	   return (tmp,hint)
+	   return (CmmHinted tmp hint)
 	
 load_target_into_temp (CmmCallee expr conv) = do 
   tmp <- maybe_assign_temp expr
diff --git a/compiler/codeGen/CgHpc.hs b/compiler/codeGen/CgHpc.hs
index 516a9c7674..cb9c7babde 100644
--- a/compiler/codeGen/CgHpc.hs
+++ b/compiler/codeGen/CgHpc.hs
@@ -73,15 +73,15 @@ initHpc this_mod (HpcInfo tickCount hashNo)
   = do { id <- newNonPtrTemp wordRep -- TODO FIXME NOW
        ; emitForeignCall'
                PlayRisky
-               [(id,NoHint)]
+               [CmmHinted id NoHint]
                (CmmCallee
                  (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False)
                   CCallConv
                )
-               [ (mkLblExpr mkHpcModuleNameLabel,PtrHint)
-               , (word32 tickCount, NoHint)
-               , (word32 hashNo,    NoHint)
-               , (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod,PtrHint)
+               [ CmmHinted (mkLblExpr mkHpcModuleNameLabel) PtrHint
+               , CmmHinted (word32 tickCount) NoHint
+               , CmmHinted (word32 hashNo)    NoHint
+               , CmmHinted (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod) PtrHint
                ]
                (Just [])
                NoC_SRT -- No SRT b/c we PlayRisky
diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs
index a73000c5af..c77e8e5968 100644
--- a/compiler/codeGen/CgPrimOp.hs
+++ b/compiler/codeGen/CgPrimOp.hs
@@ -123,9 +123,10 @@ emitPrimOp [res] ParOp [arg] live
 	-- later, we might want to inline it.
     vols <- getVolatileRegs live
     emitForeignCall' PlayRisky
-	[(res,NoHint)]
+	[CmmHinted res NoHint]
     	(CmmCallee newspark CCallConv) 
-	[(CmmReg (CmmGlobal BaseReg), PtrHint), (arg,PtrHint)] 
+	[   (CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint)
+          , (CmmHinted arg PtrHint)  ] 
 	(Just vols)
         NoC_SRT -- No SRT b/c we do PlayRisky
         CmmMayReturn
@@ -143,7 +144,8 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live
 		[{-no results-}]
 		(CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label))
 			 CCallConv)
-		[(CmmReg (CmmGlobal BaseReg), PtrHint), (mutv,PtrHint)]
+		[   (CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint)
+                  , (CmmHinted mutv PtrHint)  ]
 		(Just vols)
                 NoC_SRT -- No SRT b/c we do PlayRisky
                 CmmMayReturn
@@ -348,9 +350,9 @@ emitPrimOp [res] op args live
    | Just prim <- callishOp op
    = do vols <- getVolatileRegs live
 	emitForeignCall' PlayRisky
-	   [(res,NoHint)] 
+	   [CmmHinted res NoHint] 
 	   (CmmPrim prim) 
-	   [(a,NoHint) | a<-args]  -- ToDo: hints?
+	   [CmmHinted a NoHint | a<-args]  -- ToDo: hints?
 	   (Just vols)
            NoC_SRT -- No SRT b/c we do PlayRisky
            CmmMayReturn
diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs
index 6fd6e0165c..c9b82a4679 100644
--- a/compiler/codeGen/CgProf.hs
+++ b/compiler/codeGen/CgProf.hs
@@ -267,7 +267,7 @@ enterCostCentreThunk closure =
   ifProfiling $ do 
     stmtC $ CmmStore curCCSAddr (costCentreFrom closure)
 
-enter_ccs_fun stack = emitRtsCall SLIT("EnterFunCCS") [(stack,PtrHint)] False
+enter_ccs_fun stack = emitRtsCall SLIT("EnterFunCCS") [CmmHinted stack PtrHint] False
 			-- ToDo: vols
 
 enter_ccs_fsub = enteringPAP 0
@@ -415,8 +415,8 @@ emitSetCCC cc
 pushCostCentre :: LocalReg -> CmmExpr -> CostCentre -> Code
 pushCostCentre result ccs cc
   = emitRtsCallWithResult result PtrHint
-	SLIT("PushCostCentre") [(ccs,PtrHint), 
-				(CmmLit (mkCCostCentre cc), PtrHint)]
+	SLIT("PushCostCentre") [CmmHinted ccs PtrHint, 
+				CmmHinted (CmmLit (mkCCostCentre cc)) PtrHint]
         False
 
 bumpSccCount :: CmmExpr -> CmmStmt
diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs
index 13add6c0bf..adb48cd0d5 100644
--- a/compiler/codeGen/CgUtils.hs
+++ b/compiler/codeGen/CgUtils.hs
@@ -333,24 +333,24 @@ emitIfThenElse cond then_part else_part
        ; labelC join_id
        }
 
-emitRtsCall :: LitString -> [(CmmExpr,MachHint)] -> Bool -> Code
+emitRtsCall :: LitString -> [CmmHinted CmmExpr] -> Bool -> Code
 emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe
    -- The 'Nothing' says "save all global registers"
 
-emitRtsCallWithVols :: LitString -> [(CmmExpr,MachHint)] -> [GlobalReg] -> Bool -> Code
+emitRtsCallWithVols :: LitString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code
 emitRtsCallWithVols fun args vols safe
    = emitRtsCall' [] fun args (Just vols) safe
 
 emitRtsCallWithResult :: LocalReg -> MachHint -> LitString
-	-> [(CmmExpr,MachHint)] -> Bool -> Code
+	-> [CmmHinted CmmExpr] -> Bool -> Code
 emitRtsCallWithResult res hint fun args safe
-   = emitRtsCall' [(res,hint)] fun args Nothing safe
+   = emitRtsCall' [CmmHinted res hint] fun args Nothing safe
 
 -- Make a call to an RTS C procedure
 emitRtsCall'
    :: CmmFormals
    -> LitString
-   -> [(CmmExpr,MachHint)]
+   -> [CmmHinted CmmExpr]
    -> Maybe [GlobalReg]
    -> Bool -- True <=> CmmSafe call
    -> Code
diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs
index 7981a40fc1..6d3bf7ca75 100644
--- a/compiler/nativeGen/AsmCodeGen.lhs
+++ b/compiler/nativeGen/AsmCodeGen.lhs
@@ -719,9 +719,9 @@ cmmStmtConFold stmt
 			        e' <- cmmExprConFold CallReference e
 			        return $ CmmCallee e' conv
 			      other -> return other
-                 args' <- mapM (\(arg, hint) -> do
+                 args' <- mapM (\(CmmHinted arg hint) -> do
                                   arg' <- cmmExprConFold DataReference arg
-                                  return (arg', hint)) args
+                                  return (CmmHinted arg' hint)) args
 	         return $ CmmCall target' regs args' srt returns
 
         CmmCondBranch test dest
diff --git a/compiler/nativeGen/MachCodeGen.hs b/compiler/nativeGen/MachCodeGen.hs
index 4692f06f5a..8f6cfcb516 100644
--- a/compiler/nativeGen/MachCodeGen.hs
+++ b/compiler/nativeGen/MachCodeGen.hs
@@ -3054,7 +3054,7 @@ genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL
 	-- we keep it this long in order to prevent earlier optimisations.
 
 -- we only cope with a single result for foreign calls
-genCCall (CmmPrim op) [(r,_)] args = do
+genCCall (CmmPrim op) [CmmHinted r _] args = do
   case op of
 	MO_F32_Sqrt -> actuallyInlineFloatOp F32  (GSQRT F32) args
 	MO_F64_Sqrt -> actuallyInlineFloatOp F64 (GSQRT F64) args
@@ -3070,14 +3070,14 @@ genCCall (CmmPrim op) [(r,_)] args = do
 	
 	other_op    -> outOfLineFloatOp op r args
  where
-  actuallyInlineFloatOp rep instr [(x,_)]
+  actuallyInlineFloatOp rep instr [CmmHinted x _]
 	= do res <- trivialUFCode rep instr x
 	     any <- anyReg res
  	     return (any (getRegisterReg (CmmLocal r)))
 
 genCCall target dest_regs args = do
     let
-        sizes               = map (arg_size . cmmExprRep . fst) (reverse args)
+        sizes               = map (arg_size . cmmExprRep . hintlessCmm) (reverse args)
 #if !darwin_TARGET_OS        
         tot_arg_size        = sum sizes
 #else
@@ -3129,7 +3129,7 @@ genCCall target dest_regs args = do
     let
 	-- assign the results, if necessary
 	assign_code []     = nilOL
-	assign_code [(dest,_hint)] = 
+	assign_code [CmmHinted dest _hint] = 
 	  case rep of
 		I64 -> toOL [MOV I32 (OpReg eax) (OpReg r_dest),
 			     MOV I32 (OpReg edx) (OpReg r_dest_hi)]
@@ -3156,10 +3156,10 @@ genCCall target dest_regs args = do
                 | otherwise = x + a - (x `mod` a)
 
 
-    push_arg :: (CmmExpr,MachHint){-current argument-}
+    push_arg :: (CmmHinted CmmExpr){-current argument-}
                     -> NatM InstrBlock  -- code
 
-    push_arg (arg,_hint) -- we don't need the hints on x86
+    push_arg (CmmHinted arg _hint) -- we don't need the hints on x86
       | arg_rep == I64 = do
         ChildCode64 code r_lo <- iselExpr64 arg
         delta <- getDeltaNat
@@ -3213,13 +3213,13 @@ outOfLineFloatOp mop res args
         
       if localRegRep res == F64
         then
-          stmtToInstrs (CmmCall target [(res,FloatHint)] args CmmUnsafe CmmMayReturn)
+          stmtToInstrs (CmmCall target [CmmHinted res FloatHint] args CmmUnsafe CmmMayReturn)
         else do
           uq <- getUniqueNat
           let 
             tmp = LocalReg uq F64 GCKindNonPtr
           -- in
-          code1 <- stmtToInstrs (CmmCall target [(tmp,FloatHint)] args CmmUnsafe CmmMayReturn)
+          code1 <- stmtToInstrs (CmmCall target [CmmHinted tmp FloatHint] args CmmUnsafe CmmMayReturn)
           code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp)))
           return (code1 `appOL` code2)
   where
@@ -3268,7 +3268,8 @@ genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL
 	-- write barrier compiles to no code on x86/x86-64; 
 	-- we keep it this long in order to prevent earlier optimisations.
 
-genCCall (CmmPrim op) [(r,_)] args = 
+
+genCCall (CmmPrim op) [CmmHinted r _] args = 
   outOfLineFloatOp op r args
 
 genCCall target dest_regs args = do
@@ -3348,7 +3349,7 @@ genCCall target dest_regs args = do
     let
 	-- assign the results, if necessary
 	assign_code []     = nilOL
-	assign_code [(dest,_hint)] = 
+	assign_code [CmmHinted dest _hint] = 
 	  case rep of
 		F32 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
 		F64 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest))
@@ -3368,16 +3369,16 @@ genCCall target dest_regs args = do
   where
     arg_size = 8 -- always, at the mo
 
-    load_args :: [(CmmExpr,MachHint)]
+    load_args :: [CmmHinted CmmExpr]
 	      -> [Reg] 			-- int regs avail for args
 	      -> [Reg] 			-- FP regs avail for args
 	      -> InstrBlock
-	      -> NatM ([(CmmExpr,MachHint)],[Reg],[Reg],InstrBlock)
+	      -> NatM ([CmmHinted CmmExpr],[Reg],[Reg],InstrBlock)
     load_args args [] [] code     =  return (args, [], [], code)
 	-- no more regs to use
     load_args [] aregs fregs code =  return ([], aregs, fregs, code)
 	-- no more args to push
-    load_args ((arg,hint) : rest) aregs fregs code
+    load_args ((CmmHinted arg hint) : rest) aregs fregs code
 	| isFloatingRep arg_rep = 
 	case fregs of
 	  [] -> push_this_arg
@@ -3395,10 +3396,10 @@ genCCall target dest_regs args = do
 
 	  push_this_arg = do
 	    (args',ars,frs,code') <- load_args rest aregs fregs code
-	    return ((arg,hint):args', ars, frs, code')
+	    return ((CmmHinted arg hint):args', ars, frs, code')
 
     push_args [] code = return code
-    push_args ((arg,hint):rest) code
+    push_args ((CmmHinted arg hint):rest) code
        | isFloatingRep arg_rep = do
 	 (arg_reg, arg_code) <- getSomeReg arg
          delta <- getDeltaNat
@@ -3459,7 +3460,7 @@ genCCall target dest_regs args = do
 
 genCCall target dest_regs argsAndHints = do
     let
-        args = map fst argsAndHints
+        args = map hintlessCmm argsAndHints
     argcode_and_vregs <- mapM arg_to_int_vregs args
     let 
         (argcodes, vregss) = unzip argcode_and_vregs
@@ -3694,7 +3695,7 @@ genCCall target dest_regs argsAndHints
         initialStackOffset = 8
         stackDelta finalStack = roundTo 16 finalStack
 #endif
-	args = map fst argsAndHints
+	args = map hintlessCmm argsAndHints
 	argReps = map cmmExprRep args
 
 	roundTo a x | x `mod` a == 0 = x
@@ -3809,7 +3810,7 @@ genCCall target dest_regs argsAndHints
         moveResult reduceToF32 =
             case dest_regs of
                 [] -> nilOL
-                [(dest, _hint)]
+                [CmmHinted dest _hint]
                     | reduceToF32 && rep == F32 -> unitOL (FRSP r_dest f1)
                     | rep == F32 || rep == F64 -> unitOL (MR r_dest f1)
                     | rep == I64 -> toOL [MR (getHiVRegFromLo r_dest) r3,