diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs index d8092261310941faabccc6fa33026b17fc47fb22..9e43be6081cad0ca51d8c6aed23f16c6af2f1fea 100644 --- a/ghc/compiler/simplCore/SimplCore.lhs +++ b/ghc/compiler/simplCore/SimplCore.lhs @@ -27,7 +27,7 @@ import CoreSyn import CoreUtils ( coreExprType ) import SimplUtils ( etaCoreExpr, typeOkForCase ) import CoreUnfold -import Literal ( Literal(..), literalType, mkMachInt ) +import Literal ( Literal(..), literalType, mkMachInt, mkMachInt_safe ) import ErrUtils ( ghcExit, dumpIfSet, doIfSet ) import FiniteMap ( FiniteMap, emptyFM ) import FloatIn ( floatInwards ) @@ -482,10 +482,10 @@ tidyCoreArg (TyArg ty) = tidyTy ty `thenTM` \ ty' -> \end{code} \begin{code} -tidyPrimOp (CCallOp fn casm gc tys ty) +tidyPrimOp (CCallOp fn casm gc cconv tys ty) = mapTM tidyTy tys `thenTM` \ tys' -> tidyTy ty `thenTM` \ ty' -> - returnTM (CCallOp fn casm gc tys' ty') + returnTM (CCallOp fn casm gc cconv tys' ty') tidyPrimOp other_prim_op = returnTM other_prim_op \end{code} @@ -513,7 +513,7 @@ litToRep (NoRepStr s) then -- Must cater for NULs in literal string mkGenApp (Var unpackCString2Id) [LitArg (MachStr s), - LitArg (mkMachInt (toInteger (_LENGTH_ s)))] + LitArg (mkMachInt_safe (toInteger (_LENGTH_ s)))] else -- No NULs in the string App (Var unpackCStringId) (LitArg (MachStr s)) @@ -536,7 +536,7 @@ litToRep (NoRepInteger i integer_ty) | i > tARGET_MIN_INT && -- Small enough, so start from an Int i < tARGET_MAX_INT - = Prim Int2IntegerOp [LitArg (mkMachInt i)] + = Prim Int2IntegerOp [LitArg (mkMachInt (fromInteger i))] | otherwise -- Big, so start from a string = Prim Addr2IntegerOp [LitArg (MachStr (_PK_ (show i)))] diff --git a/ghc/compiler/simplCore/SimplPgm.lhs b/ghc/compiler/simplCore/SimplPgm.lhs index e365817dfcd7ffff7188c891abec3ab11a3dbe11..c04aaac9d382931490286ec235080c7e69104eb9 100644 --- a/ghc/compiler/simplCore/SimplPgm.lhs +++ b/ghc/compiler/simplCore/SimplPgm.lhs @@ -25,10 +25,9 @@ import UniqSupply ( thenUs, returnUs, mapUs, splitUniqSupply, UniqSM, UniqSupply ) -import Util ( isIn, isn'tIn, removeDups ) +import Util ( isIn, isn'tIn, removeDups, trace ) import Outputable -import GlaExts ( trace ) \end{code} \begin{code} diff --git a/ghc/compiler/simplCore/Simplify.lhs b/ghc/compiler/simplCore/Simplify.lhs index 5b0be27ccd6f9a9e84126a6180698fde1a3322ee..eba387c909f410a979b4bac18f80e6b5d9b8c729 100644 --- a/ghc/compiler/simplCore/Simplify.lhs +++ b/ghc/compiler/simplCore/Simplify.lhs @@ -275,10 +275,10 @@ simplExpr env (Prim op prim_args) args result_ty where -- PrimOps just need any types in them renamed. - simpl_op (CCallOp label is_asm may_gc arg_tys result_ty) + simpl_op (CCallOp label is_asm may_gc cconv arg_tys result_ty) = mapEager (simplTy env) arg_tys `appEager` \ arg_tys' -> simplTy env result_ty `appEager` \ result_ty' -> - returnEager (CCallOp label is_asm may_gc arg_tys' result_ty') + returnEager (CCallOp label is_asm may_gc cconv arg_tys' result_ty') simpl_op other_op = returnEager other_op \end{code} @@ -327,8 +327,8 @@ simplExpr env tylam@(Lam (TyBinder tyvar) body) [] result_ty returnSmpl (Lam (TyBinder tyvar') body') #ifdef DEBUG -simplExpr env (Lam (TyBinder _) _) (_ : _) result_ty - = panic "simplExpr:TyLam with non-TyArg" +simplExpr env e@(Lam (TyBinder _) _) args@(_ : _) result_ty + = pprPanic "simplExpr:TyLam with non-TyArg" (ppr e $$ ppr args) #endif \end{code}