diff options
| -rw-r--r-- | compiler/cmm/Cmm.hs | 16 | ||||
| -rw-r--r-- | compiler/cmm/CmmBrokenBlock.hs | 8 | ||||
| -rw-r--r-- | compiler/cmm/CmmCPS.hs | 8 | ||||
| -rw-r--r-- | compiler/cmm/CmmCPSGen.hs | 18 | ||||
| -rw-r--r-- | compiler/cmm/CmmLint.hs | 6 | ||||
| -rw-r--r-- | compiler/cmm/CmmLive.hs | 8 | ||||
| -rw-r--r-- | compiler/cmm/CmmOpt.hs | 2 | ||||
| -rw-r--r-- | compiler/cmm/CmmProcPointZ.hs | 4 | ||||
| -rw-r--r-- | compiler/cmm/CmmUtils.hs | 4 | ||||
| -rw-r--r-- | compiler/cmm/PprC.hs | 14 | ||||
| -rw-r--r-- | compiler/cmm/PprCmm.hs | 22 | ||||
| -rw-r--r-- | compiler/cmm/ZipCfgCmmRep.hs | 16 | ||||
| -rw-r--r-- | compiler/codeGen/CgCase.lhs | 2 | ||||
| -rw-r--r-- | compiler/codeGen/CgClosure.lhs | 2 | ||||
| -rw-r--r-- | compiler/codeGen/CgExpr.lhs | 4 | ||||
| -rw-r--r-- | compiler/codeGen/CgForeignCall.hs | 22 | ||||
| -rw-r--r-- | compiler/codeGen/CgHpc.hs | 10 | ||||
| -rw-r--r-- | compiler/codeGen/CgPrimOp.hs | 14 | ||||
| -rw-r--r-- | compiler/codeGen/CgProf.hs | 6 | ||||
| -rw-r--r-- | compiler/codeGen/CgUtils.hs | 10 | ||||
| -rw-r--r-- | compiler/nativeGen/AsmCodeGen.lhs | 4 | ||||
| -rw-r--r-- | compiler/nativeGen/MachCodeGen.hs | 36 |
22 files changed, 118 insertions, 118 deletions
diff --git a/compiler/cmm/Cmm.hs b/compiler/cmm/Cmm.hs index 3fd5e441a6..53a6d0addf 100644 --- a/compiler/cmm/Cmm.hs +++ b/compiler/cmm/Cmm.hs @@ -18,7 +18,7 @@ module Cmm ( CmmReturnInfo(..), CmmStmt(..), CmmActual, CmmActuals, CmmFormal, CmmFormals, CmmKind, CmmFormalsWithoutKinds, CmmFormalWithoutKind, - CmmHinted(..), + CmmKinded(..), CmmSafety(..), CmmCallTarget(..), CmmStatic(..), Section(..), @@ -241,10 +241,10 @@ data CmmStmt CmmActuals -- with these return values. type CmmKind = MachHint -data CmmHinted a = CmmHinted { hintlessCmm :: a, cmmHint :: CmmKind } +data CmmKinded a = CmmKinded { kindlessCmm :: a, cmmKind :: CmmKind } deriving (Eq) -type CmmActual = CmmHinted CmmExpr -type CmmFormal = CmmHinted LocalReg +type CmmActual = CmmKinded CmmExpr +type CmmFormal = CmmKinded LocalReg type CmmActuals = [CmmActual] type CmmFormals = [CmmFormal] type CmmFormalWithoutKind = LocalReg @@ -253,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 (CmmHinted a) where - foldRegsUsed f set (CmmHinted a _) = foldRegsUsed f set a +instance UserOfLocalRegs a => UserOfLocalRegs (CmmKinded a) where + foldRegsUsed f set (CmmKinded a _) = foldRegsUsed f set a instance UserOfLocalRegs CmmStmt where foldRegsUsed f set s = stmt s set @@ -276,8 +276,8 @@ instance UserOfLocalRegs CmmCallTarget where --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) +instance (Outputable a) => Outputable (CmmKinded a) where + ppr (CmmKinded a k) = ppr (a, k) {- Discussion diff --git a/compiler/cmm/CmmBrokenBlock.hs b/compiler/cmm/CmmBrokenBlock.hs index 20a4a8c85e..526bdc1dd1 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 hintlessCmm formals) srt is_gc) + BrokenBlock ident (ContinuationEntry (map kindlessCmm 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 hintlessCmm formals) srt is_gc) + (ContinuationEntry (map kindlessCmm formals) srt is_gc) next format_formals adaptor_ident = BlockId unique @@ -390,8 +390,8 @@ adaptBlockToFormat formats unique (CmmLit (CmmLabel (mkReturnPtLabel (getUnique next)))) (map formal_to_actual format_formals) - formal_to_actual (CmmHinted reg hint) - = (CmmHinted (CmmReg (CmmLocal reg)) hint) + formal_to_actual (CmmKinded reg hint) + = (CmmKinded (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 5a7998192b..a8adfb8e10 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 . hintlessCmm) args + argumentsSize (cmmExprRep . kindlessCmm) args final_arg_size (FinalJump _ args) = - argumentsSize (cmmExprRep . hintlessCmm) args + argumentsSize (cmmExprRep . kindlessCmm) 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 . hintlessCmm) args + + argumentsSize (cmmExprRep . kindlessCmm) 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 . hintlessCmm) args + argumentsSize (cmmExprRep . kindlessCmm) 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 86eebfb0af..d508184889 100644 --- a/compiler/cmm/CmmCPSGen.hs +++ b/compiler/cmm/CmmCPSGen.hs @@ -227,7 +227,7 @@ continuationToProc (max_stack, update_frame_size, formats) stack_use uniques foreignCall call_uniques (CmmPrim target) results arguments -formal_to_actual reg = CmmHinted (CmmReg (CmmLocal reg)) NoHint +formal_to_actual reg = CmmKinded (CmmReg (CmmLocal reg)) NoHint foreignCall :: [Unique] -> CmmCallTarget -> CmmFormals -> CmmActuals -> [CmmStmt] foreignCall uniques call results arguments = @@ -235,14 +235,14 @@ foreignCall uniques call results arguments = saveThreadState ++ caller_save ++ [CmmCall (CmmCallee suspendThread CCallConv) - [ CmmHinted id PtrHint ] - [ CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint ] + [ CmmKinded id PtrHint ] + [ CmmKinded (CmmReg (CmmGlobal BaseReg)) PtrHint ] CmmUnsafe CmmMayReturn, CmmCall call results new_args CmmUnsafe CmmMayReturn, CmmCall (CmmCallee resumeThread CCallConv) - [ CmmHinted new_base PtrHint ] - [ CmmHinted (CmmReg (CmmLocal id)) PtrHint ] + [ CmmKinded new_base PtrHint ] + [ CmmKinded (CmmReg (CmmLocal id)) PtrHint ] CmmUnsafe CmmMayReturn, -- Assign the result to BaseReg: we @@ -250,7 +250,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 . hintlessCmm) results)] + [CmmJump (CmmReg spReg) (map (formal_to_actual . kindlessCmm) results)] where (_, arg_stmts, new_args) = loadArgsIntoTemps argument_uniques arguments @@ -362,12 +362,12 @@ tail_call spRel target arguments = store_arguments ++ adjust_sp_reg spRel ++ jump where store_arguments = [stack_put spRel expr offset - | ((CmmHinted expr _), StackParam offset) <- argument_formats] ++ + | ((CmmKinded expr _), StackParam offset) <- argument_formats] ++ [global_put expr global - | ((CmmHinted expr _), RegisterParam global) <- argument_formats] + | ((CmmKinded expr _), RegisterParam global) <- argument_formats] jump = [CmmJump target arguments] - argument_formats = assignArguments (cmmExprRep . hintlessCmm) arguments + argument_formats = assignArguments (cmmExprRep . kindlessCmm) arguments adjust_sp_reg spRel = if spRel == 0 diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs index bf10135b5f..f36df5970e 100644 --- a/compiler/cmm/CmmLint.hs +++ b/compiler/cmm/CmmLint.hs @@ -136,7 +136,7 @@ lintCmmStmt labels = lint lintCmmExpr r return () lint (CmmCall target _res args _ _) = - lintTarget target >> mapM_ (lintCmmExpr . hintlessCmm) args + lintTarget target >> mapM_ (lintCmmExpr . kindlessCmm) args lint (CmmCondBranch e id) = checkTarget id >> lintCmmExpr e >> checkCond e lint (CmmSwitch e branches) = do mapM_ checkTarget $ catMaybes branches @@ -144,8 +144,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 . hintlessCmm) args - lint (CmmReturn ress) = mapM_ (lintCmmExpr . hintlessCmm) ress + lint (CmmJump e args) = lintCmmExpr e >> mapM_ (lintCmmExpr . kindlessCmm) args + lint (CmmReturn ress) = mapM_ (lintCmmExpr . kindlessCmm) 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 f9973deb56..2450b70af3 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 hintlessCmm formals +cmmFormalsToLiveLocals formals = map kindlessCmm 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 hintlessCmm arguments) . + foldr ((.) . cmmExprLive) id (map kindlessCmm 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 hintlessCmm params) $ emptyUniqSet) + const (cmmExprLive expr $ foldr ((.) . cmmExprLive) id (map kindlessCmm params) $ emptyUniqSet) cmmStmtLive _ (CmmReturn params) = - const (foldr ((.) . cmmExprLive) id (map hintlessCmm params) $ emptyUniqSet) + const (foldr ((.) . cmmExprLive) id (map kindlessCmm params) $ emptyUniqSet) -------------------------------- -- Liveness of a CmmExpr diff --git a/compiler/cmm/CmmOpt.hs b/compiler/cmm/CmmOpt.hs index 6adafb5feb..9873e29cfd 100644 --- a/compiler/cmm/CmmOpt.hs +++ b/compiler/cmm/CmmOpt.hs @@ -155,7 +155,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' = [ (CmmHinted (inlineExpr u a e) hint) | (CmmHinted e hint) <- es ] + es' = [ (CmmKinded (inlineExpr u a e) hint) | (CmmKinded 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/CmmProcPointZ.hs b/compiler/cmm/CmmProcPointZ.hs index fc6b726544..59049d24cc 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 -> CmmHinted x NoHint) formals + hinted_formals = map (\x -> CmmKinded 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 -> CmmHinted x NoHint) $ uniqSetToList live + formals = map (\x -> CmmKinded 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 c44cc3a53a..1922ee05c4 100644 --- a/compiler/cmm/CmmUtils.hs +++ b/compiler/cmm/CmmUtils.hs @@ -197,10 +197,10 @@ loadArgsIntoTemps :: [Unique] -> CmmActuals -> ([Unique], [CmmStmt], CmmActuals) loadArgsIntoTemps uniques [] = (uniques, [], []) -loadArgsIntoTemps uniques ((CmmHinted e hint):args) = +loadArgsIntoTemps uniques ((CmmKinded e hint):args) = (uniques'', new_stmts ++ remaining_stmts, - (CmmHinted new_e hint) : remaining_e) + (CmmKinded 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 fca199c738..a943575d51 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -241,9 +241,9 @@ pprCFunType ppr_fn cconv ress args parens (commafy (map arg_type args)) where res_type [] = ptext (sLit "void") - res_type [CmmHinted one hint] = machRepHintCType (localRegRep one) hint + res_type [CmmKinded one hint] = machRepHintCType (localRegRep one) hint - arg_type (CmmHinted expr hint) = machRepHintCType (cmmExprRep expr) hint + arg_type (CmmKinded expr hint) = machRepHintCType (cmmExprRep expr) hint -- --------------------------------------------------------------------- -- unconditional branches @@ -751,16 +751,16 @@ pprCall ppr_fn cconv results args _ ppr_assign results (ppr_fn <> parens (commafy (map pprArg args))) <> semi where ppr_assign [] rhs = rhs - ppr_assign [CmmHinted one hint] rhs + ppr_assign [CmmKinded one hint] rhs = pprLocalReg one <> ptext (sLit " = ") <> pprUnHint hint (localRegRep one) <> rhs ppr_assign _other _rhs = panic "pprCall: multiple results" - pprArg (CmmHinted expr hint) + pprArg (CmmKinded expr hint) | hint `elem` [PtrHint,SignedHint] = cCast (machRepHintCType (cmmExprRep expr) hint) expr -- see comment by machRepHintCType below - pprArg (CmmHinted expr _other) + pprArg (CmmKinded expr _other) = pprExpr expr pprUnHint PtrHint rep = parens (machRepCType rep) @@ -844,8 +844,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.hintlessCmm) rs >> - mapM_ (te_Expr.hintlessCmm) es +te_Stmt (CmmCall _ rs es _ _) = mapM_ (te_temp.kindlessCmm) rs >> + mapM_ (te_Expr.kindlessCmm) 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 24b1287bef..e26bb1be4d 100644 --- a/compiler/cmm/PprCmm.hs +++ b/compiler/cmm/PprCmm.hs @@ -246,9 +246,9 @@ pprStmt stmt = case stmt of | otherwise = commafy (map ppr_ar results) <+> equals -- Don't print the hints on a native C-- call ppr_ar arg = case cconv of - CmmCallConv -> ppr (hintlessCmm arg) - _ -> doubleQuotes (ppr $ cmmHint arg) <+> - ppr (hintlessCmm arg) + CmmCallConv -> ppr (kindlessCmm arg) + _ -> doubleQuotes (ppr $ cmmKind arg) <+> + ppr (kindlessCmm arg) _pp_conv = case cconv of CmmCallConv -> empty _ -> ptext (sLit "foreign") <+> doubleQuotes (ppr cconv) @@ -294,7 +294,7 @@ genCondBranch expr ident = -- -- jump foo(a, b, c); -- -genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc +genJump :: CmmExpr -> [CmmKinded CmmExpr] -> SDoc genJump expr args = hcat [ ptext (sLit "jump") @@ -305,21 +305,21 @@ genJump expr args = CmmLoad (CmmReg _) _ -> pprExpr expr _ -> parens (pprExpr expr) , space - , parens ( commafy $ map pprHinted args ) + , parens ( commafy $ map pprKinded args ) , semi ] -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 +pprKinded :: Outputable a => (CmmKinded a) -> SDoc +pprKinded (CmmKinded a NoHint) = ppr a +pprKinded (CmmKinded a PtrHint) = quotes(text "address") <+> ppr a +pprKinded (CmmKinded a SignedHint) = quotes(text "signed") <+> ppr a +pprKinded (CmmKinded 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 :: [CmmHinted CmmExpr] -> SDoc +genReturn :: [CmmKinded CmmExpr] -> SDoc genReturn args = hcat [ ptext (sLit "return") diff --git a/compiler/cmm/ZipCfgCmmRep.hs b/compiler/cmm/ZipCfgCmmRep.hs index 1fda97139e..47233e835e 100644 --- a/compiler/cmm/ZipCfgCmmRep.hs +++ b/compiler/cmm/ZipCfgCmmRep.hs @@ -14,7 +14,7 @@ where import CmmExpr import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo - , CmmCallTarget(..), CmmActuals, CmmFormals, CmmHinted(..) + , CmmCallTarget(..), CmmActuals, CmmFormals, CmmKinded(..) , CmmStmt(..) -- imported in order to call ppr on Switch and to -- implement pprCmmGraphLikeCmm , CmmSafety(CmmSafe) -- for pprCmmGraphLikeCmm @@ -213,12 +213,12 @@ pprMiddle stmt = pp_stmt <+> pp_debug CopyIn conv args _ -> if null args then ptext (sLit "empty CopyIn") - else commafy (map pprHinted args) <+> equals <+> + else commafy (map pprKinded args) <+> equals <+> ptext (sLit "foreign") <+> doubleQuotes(ppr conv) <+> ptext (sLit "...") CopyOut conv args -> ptext (sLit "next, pass") <+> doubleQuotes(ppr conv) <+> - parens (commafy (map pprHinted args)) + parens (commafy (map pprKinded args)) -- // text MidComment s -> text "//" <+> ftext s @@ -270,11 +270,11 @@ ppr_target t@(CmmLit _) = ppr t ppr_target fn' = parens (ppr fn') -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 +pprKinded :: Outputable a => CmmKinded a -> SDoc +pprKinded (CmmKinded a NoHint) = ppr a +pprKinded (CmmKinded a PtrHint) = doubleQuotes (text "address") <+> ppr a +pprKinded (CmmKinded a SignedHint) = doubleQuotes (text "signed") <+> ppr a +pprKinded (CmmKinded 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 beecceb209..49c782e12a 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 (zipWith CmmHinted res_tmps res_hints) fcall args live_in_alts + ; cgForeignCall (zipWith CmmKinded 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 6c8ed29ce2..902b975a91 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") [CmmHinted (CmmReg nodeReg) PtrHint] [node] False + ; emitRtsCallWithVols (sLit "newCAF") [CmmKinded (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 3f1ec45c77..f22071e2c5 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 = zipWith CmmHinted arg_tmps (map (typeHint.stgArgType) stg_args) + let arg_hints = zipWith CmmKinded 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 (zipWith CmmHinted res_regs res_hints) fcall + emitForeignCall (zipWith CmmKinded 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 ac8e99eafe..b3d779e182 100644 --- a/compiler/codeGen/CgForeignCall.hs +++ b/compiler/codeGen/CgForeignCall.hs @@ -63,7 +63,7 @@ cgForeignCall results fcall stg_args live | (stg_arg, (rep,expr)) <- stg_args `zip` reps_n_amodes, nonVoidArg rep] - arg_hints = zipWith CmmHinted + arg_hints = zipWith CmmKinded arg_exprs (map (typeHint.stgArgType) stg_args) -- in emitForeignCall results fcall arg_hints live @@ -72,7 +72,7 @@ cgForeignCall results fcall stg_args live emitForeignCall :: CmmFormals -- where to put the results -> ForeignCall -- the op - -> [CmmHinted CmmExpr] -- arguments + -> [CmmKinded CmmExpr] -- arguments -> StgLiveVars -- live vars, in case we need to save them -> Code @@ -86,14 +86,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 (CmmHinted fn _):rest -> (rest, fn) + DynamicTarget -> case args of (CmmKinded 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.hintlessCmm) args)) + | StdCallConv <- cconv = Just (sum (map (arg_size.cmmExprRep.kindlessCmm) args)) | otherwise = Nothing -- ToDo: this might not be correct for 64-bit API @@ -108,7 +108,7 @@ emitForeignCall' :: Safety -> CmmFormals -- where to put the results -> CmmCallTarget -- the op - -> [CmmHinted CmmExpr] -- arguments + -> [CmmKinded CmmExpr] -- arguments -> Maybe [GlobalReg] -- live vars, in case we need to save them -> C_SRT -- the SRT of the calls continuation -> CmmReturnInfo @@ -137,13 +137,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) - [ CmmHinted id PtrHint ] - [ CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint ] + [ CmmKinded id PtrHint ] + [ CmmKinded (CmmReg (CmmGlobal BaseReg)) PtrHint ] CmmUnsafe ret) stmtC (CmmCall temp_target results temp_args CmmUnsafe ret) stmtC (CmmCall (CmmCallee resumeThread CCallConv) - [ CmmHinted new_base PtrHint ] - [ CmmHinted (CmmReg (CmmLocal id)) PtrHint ] + [ CmmKinded new_base PtrHint ] + [ CmmKinded (CmmReg (CmmLocal id)) PtrHint ] CmmUnsafe ret) -- Assign the result to BaseReg: we -- might now have a different Capability! @@ -163,9 +163,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 (CmmHinted e hint) = do + where arg_assign_temp (CmmKinded e hint) = do tmp <- maybe_assign_temp e - return (CmmHinted tmp hint) + return (CmmKinded 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 cb9c7babde..0d0fdb1183 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 - [CmmHinted id NoHint] + [CmmKinded id NoHint] (CmmCallee (CmmLit $ CmmLabel $ mkForeignLabel mod_alloc Nothing False) CCallConv ) - [ CmmHinted (mkLblExpr mkHpcModuleNameLabel) PtrHint - , CmmHinted (word32 tickCount) NoHint - , CmmHinted (word32 hashNo) NoHint - , CmmHinted (CmmLit $ CmmLabel $ mkHpcTicksLabel $ this_mod) PtrHint + [ CmmKinded (mkLblExpr mkHpcModuleNameLabel) PtrHint + , CmmKinded (word32 tickCount) NoHint + , CmmKinded (word32 hashNo) NoHint + , CmmKinded (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 3a3ea12f0e..85a41515e6 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -122,10 +122,10 @@ emitPrimOp [res] ParOp [arg] live -- later, we might want to inline it. vols <- getVolatileRegs live emitForeignCall' PlayRisky - [CmmHinted res NoHint] + [CmmKinded res NoHint] (CmmCallee newspark CCallConv) - [ (CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint) - , (CmmHinted arg PtrHint) ] + [ (CmmKinded (CmmReg (CmmGlobal BaseReg)) PtrHint) + , (CmmKinded arg PtrHint) ] (Just vols) NoC_SRT -- No SRT b/c we do PlayRisky CmmMayReturn @@ -143,8 +143,8 @@ emitPrimOp [] WriteMutVarOp [mutv,var] live [{-no results-}] (CmmCallee (CmmLit (CmmLabel mkDirty_MUT_VAR_Label)) CCallConv) - [ (CmmHinted (CmmReg (CmmGlobal BaseReg)) PtrHint) - , (CmmHinted mutv PtrHint) ] + [ (CmmKinded (CmmReg (CmmGlobal BaseReg)) PtrHint) + , (CmmKinded mutv PtrHint) ] (Just vols) NoC_SRT -- No SRT b/c we do PlayRisky CmmMayReturn @@ -349,9 +349,9 @@ emitPrimOp [res] op args live | Just prim <- callishOp op = do vols <- getVolatileRegs live emitForeignCall' PlayRisky - [CmmHinted res NoHint] + [CmmKinded res NoHint] (CmmPrim prim) - [CmmHinted a NoHint | a<-args] -- ToDo: hints? + [CmmKinded 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 4d1fd04c81..c2a8a1bd75 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") [CmmHinted stack PtrHint] False +enter_ccs_fun stack = emitRtsCall (sLit "EnterFunCCS") [CmmKinded 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") [CmmHinted ccs PtrHint, - CmmHinted (CmmLit (mkCCostCentre cc)) PtrHint] + (sLit "PushCostCentre") [CmmKinded ccs PtrHint, + CmmKinded (CmmLit (mkCCostCentre cc)) PtrHint] False bumpSccCount :: CmmExpr -> CmmStmt diff --git a/compiler/codeGen/CgUtils.hs b/compiler/codeGen/CgUtils.hs index 3861ddf888..1f44c43ab1 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 -> [CmmHinted CmmExpr] -> Bool -> Code +emitRtsCall :: LitString -> [CmmKinded CmmExpr] -> Bool -> Code emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe -- The 'Nothing' says "save all global registers" -emitRtsCallWithVols :: LitString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code +emitRtsCallWithVols :: LitString -> [CmmKinded CmmExpr] -> [GlobalReg] -> Bool -> Code emitRtsCallWithVols fun args vols safe = emitRtsCall' [] fun args (Just vols) safe emitRtsCallWithResult :: LocalReg -> MachHint -> LitString - -> [CmmHinted CmmExpr] -> Bool -> Code + -> [CmmKinded CmmExpr] -> Bool -> Code emitRtsCallWithResult res hint fun args safe - = emitRtsCall' [CmmHinted res hint] fun args Nothing safe + = emitRtsCall' [CmmKinded res hint] fun args Nothing safe -- Make a call to an RTS C procedure emitRtsCall' :: CmmFormals -> LitString - -> [CmmHinted CmmExpr] + -> [CmmKinded CmmExpr] -> Maybe [GlobalReg] -> Bool -- True <=> CmmSafe call -> Code diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index fee6209b39..5ba620bb4e 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 (\(CmmHinted arg hint) -> do + args' <- mapM (\(CmmKinded arg hint) -> do arg' <- cmmExprConFold DataReference arg - return (CmmHinted arg' hint)) args + return (CmmKinded 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 4d96bb0a2f..3abe820c9e 100644 --- a/compiler/nativeGen/MachCodeGen.hs +++ b/compiler/nativeGen/MachCodeGen.hs @@ -3049,7 +3049,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) [CmmHinted r _] args = do +genCCall (CmmPrim op) [CmmKinded r _] args = do case op of MO_F32_Sqrt -> actuallyInlineFloatOp F32 (GSQRT F32) args MO_F64_Sqrt -> actuallyInlineFloatOp F64 (GSQRT F64) args @@ -3065,14 +3065,14 @@ genCCall (CmmPrim op) [CmmHinted r _] args = do other_op -> outOfLineFloatOp op r args where - actuallyInlineFloatOp rep instr [CmmHinted x _] + actuallyInlineFloatOp rep instr [CmmKinded 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 . hintlessCmm) (reverse args) + sizes = map (arg_size . cmmExprRep . kindlessCmm) (reverse args) #if !darwin_TARGET_OS tot_arg_size = sum sizes #else @@ -3124,7 +3124,7 @@ genCCall target dest_regs args = do let -- assign the results, if necessary assign_code [] = nilOL - assign_code [CmmHinted dest _hint] = + assign_code [CmmKinded dest _hint] = case rep of I64 -> toOL [MOV I32 (OpReg eax) (OpReg r_dest), MOV I32 (OpReg edx) (OpReg r_dest_hi)] @@ -3151,10 +3151,10 @@ genCCall target dest_regs args = do | otherwise = x + a - (x `mod` a) - push_arg :: (CmmHinted CmmExpr){-current argument-} + push_arg :: (CmmKinded CmmExpr){-current argument-} -> NatM InstrBlock -- code - push_arg (CmmHinted arg _hint) -- we don't need the hints on x86 + push_arg (CmmKinded arg _hint) -- we don't need the hints on x86 | arg_rep == I64 = do ChildCode64 code r_lo <- iselExpr64 arg delta <- getDeltaNat @@ -3208,13 +3208,13 @@ outOfLineFloatOp mop res args if localRegRep res == F64 then - stmtToInstrs (CmmCall target [CmmHinted res FloatHint] args CmmUnsafe CmmMayReturn) + stmtToInstrs (CmmCall target [CmmKinded res FloatHint] args CmmUnsafe CmmMayReturn) else do uq <- getUniqueNat let tmp = LocalReg uq F64 GCKindNonPtr -- in - code1 <- stmtToInstrs (CmmCall target [CmmHinted tmp FloatHint] args CmmUnsafe CmmMayReturn) + code1 <- stmtToInstrs (CmmCall target [CmmKinded tmp FloatHint] args CmmUnsafe CmmMayReturn) code2 <- stmtToInstrs (CmmAssign (CmmLocal res) (CmmReg (CmmLocal tmp))) return (code1 `appOL` code2) where @@ -3264,7 +3264,7 @@ genCCall (CmmPrim MO_WriteBarrier) _ _ = return nilOL -- we keep it this long in order to prevent earlier optimisations. -genCCall (CmmPrim op) [CmmHinted r _] args = +genCCall (CmmPrim op) [CmmKinded r _] args = outOfLineFloatOp op r args genCCall target dest_regs args = do @@ -3344,7 +3344,7 @@ genCCall target dest_regs args = do let -- assign the results, if necessary assign_code [] = nilOL - assign_code [CmmHinted dest _hint] = + assign_code [CmmKinded dest _hint] = case rep of F32 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest)) F64 -> unitOL (MOV rep (OpReg xmm0) (OpReg r_dest)) @@ -3364,16 +3364,16 @@ genCCall target dest_regs args = do where arg_size = 8 -- always, at the mo - load_args :: [CmmHinted CmmExpr] + load_args :: [CmmKinded CmmExpr] -> [Reg] -- int regs avail for args -> [Reg] -- FP regs avail for args -> InstrBlock - -> NatM ([CmmHinted CmmExpr],[Reg],[Reg],InstrBlock) + -> NatM ([CmmKinded 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 ((CmmHinted arg hint) : rest) aregs fregs code + load_args ((CmmKinded arg hint) : rest) aregs fregs code | isFloatingRep arg_rep = case fregs of [] -> push_this_arg @@ -3391,10 +3391,10 @@ genCCall target dest_regs args = do push_this_arg = do (args',ars,frs,code') <- load_args rest aregs fregs code - return ((CmmHinted arg hint):args', ars, frs, code') + return ((CmmKinded arg hint):args', ars, frs, code') push_args [] code = return code - push_args ((CmmHinted arg hint):rest) code + push_args ((CmmKinded arg hint):rest) code | isFloatingRep arg_rep = do (arg_reg, arg_code) <- getSomeReg arg delta <- getDeltaNat @@ -3455,7 +3455,7 @@ genCCall target dest_regs args = do genCCall target dest_regs argsAndHints = do let - args = map hintlessCmm argsAndHints + args = map kindlessCmm argsAndHints argcode_and_vregs <- mapM arg_to_int_vregs args let (argcodes, vregss) = unzip argcode_and_vregs @@ -3690,7 +3690,7 @@ genCCall target dest_regs argsAndHints initialStackOffset = 8 stackDelta finalStack = roundTo 16 finalStack #endif - args = map hintlessCmm argsAndHints + args = map kindlessCmm argsAndHints argReps = map cmmExprRep args roundTo a x | x `mod` a == 0 = x @@ -3805,7 +3805,7 @@ genCCall target dest_regs argsAndHints moveResult reduceToF32 = case dest_regs of [] -> nilOL - [CmmHinted dest _hint] + [CmmKinded 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, |