From 28cb2d6d40264796fb84da1f352490fd2b8eb27f Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sat, 23 Oct 2010 16:54:22 +0000 Subject: [PATCH] Follow GHC.Bool/GHC.Types merge --- compiler/codeGen/StgCmmExpr.hs | 4 ++-- compiler/coreSyn/CoreUnfold.lhs | 2 +- compiler/coreSyn/CoreUtils.lhs | 4 ++-- compiler/prelude/PrelNames.lhs | 3 +-- compiler/prelude/TysWiredIn.lhs | 6 +++--- compiler/simplCore/SAT.lhs | 10 +++++----- rts/Exception.cmm | 6 +++--- rts/Prelude.h | 8 ++++---- rts/PrimOps.cmm | 6 +++--- rts/package.conf.in | 8 ++++---- rts/win32/libHSghc-prim.def | 4 ++-- utils/genprimopcode/Main.hs | 4 ++-- 12 files changed, 32 insertions(+), 33 deletions(-) diff --git a/compiler/codeGen/StgCmmExpr.hs b/compiler/codeGen/StgCmmExpr.hs index 50d500b..30e442b 100644 --- a/compiler/codeGen/StgCmmExpr.hs +++ b/compiler/codeGen/StgCmmExpr.hs @@ -550,8 +550,8 @@ if the assignment to the binder will be dead code (use isDeadBndr). The following example illustrates how badly the code turns out: STG: case <=## [ww_s7Hx y_s7HD] of wild2_sbH8 { - GHC.Bool.False -> // sbH8 dead - GHC.Bool.True -> // sbH8 dead + GHC.Types.False -> // sbH8 dead + GHC.Types.True -> // sbH8 dead }; Cmm: _s7HD::F64 = F64[_sbH7::I64 + 7]; // MidAssign diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index 7ab0e23..e007682 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -871,7 +871,7 @@ But the defn of GHC.Classes.$dmmin is: {- Arity: 3, HasNoCafRefs, Strictness: SLL, Unfolding: (\ @ a $dOrd :: GHC.Classes.Ord a x :: a y :: a -> case @ a GHC.Classes.<= @ a $dOrd x y of wild { - GHC.Bool.False -> y GHC.Bool.True -> x }) -} + GHC.Types.False -> y GHC.Types.True -> x }) -} We *really* want to inline $dmmin, even though it has arity 3, in order to unravel the recursion. diff --git a/compiler/coreSyn/CoreUtils.lhs b/compiler/coreSyn/CoreUtils.lhs index 3521aeb..69a5135 100644 --- a/compiler/coreSyn/CoreUtils.lhs +++ b/compiler/coreSyn/CoreUtils.lhs @@ -732,8 +732,8 @@ If exprOkForSpeculation doesn't look through case expressions, you get this: \ (ww :: GHC.Prim.Int#) -> case ww of ds { __DEFAULT -> case (case <# ds 5 of _ { - GHC.Bool.False -> lvl1; - GHC.Bool.True -> lvl}) + GHC.Types.False -> lvl1; + GHC.Types.True -> lvl}) of _ { __DEFAULT -> T.$wfoo (GHC.Prim.-# ds_XkE 1) }; 0 -> 0 diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index a10ee2d..e2e2dfe 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -236,7 +236,7 @@ genericTyConNames = [crossTyConName, plusTyConName, genUnitTyConName] pRELUDE :: Module pRELUDE = mkBaseModule_ pRELUDE_NAME -gHC_PRIM, gHC_TYPES, gHC_BOOL, gHC_UNIT, gHC_ORDERING, gHC_GENERICS, +gHC_PRIM, gHC_TYPES, gHC_UNIT, gHC_ORDERING, gHC_GENERICS, gHC_MAGIC, gHC_CLASSES, gHC_BASE, gHC_ENUM, gHC_SHOW, gHC_READ, gHC_NUM, gHC_INTEGER, gHC_INTEGER_TYPE, gHC_LIST, gHC_PARR, @@ -250,7 +250,6 @@ gHC_PRIM, gHC_TYPES, gHC_BOOL, gHC_UNIT, gHC_ORDERING, gHC_GENERICS, gHC_PRIM = mkPrimModule (fsLit "GHC.Prim") -- Primitive types and values gHC_TYPES = mkPrimModule (fsLit "GHC.Types") gHC_UNIT = mkPrimModule (fsLit "GHC.Unit") -gHC_BOOL = mkPrimModule (fsLit "GHC.Bool") gHC_ORDERING = mkPrimModule (fsLit "GHC.Ordering") gHC_GENERICS = mkPrimModule (fsLit "GHC.Generics") gHC_MAGIC = mkPrimModule (fsLit "GHC.Magic") diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs index ab62ae0..f77b272 100644 --- a/compiler/prelude/TysWiredIn.lhs +++ b/compiler/prelude/TysWiredIn.lhs @@ -153,9 +153,9 @@ intTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Int") intTyCo intDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "I#") intDataConKey intDataCon boolTyConName, falseDataConName, trueDataConName :: Name -boolTyConName = mkWiredInTyConName UserSyntax gHC_BOOL (fsLit "Bool") boolTyConKey boolTyCon -falseDataConName = mkWiredInDataConName UserSyntax gHC_BOOL (fsLit "False") falseDataConKey falseDataCon -trueDataConName = mkWiredInDataConName UserSyntax gHC_BOOL (fsLit "True") trueDataConKey trueDataCon +boolTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Bool") boolTyConKey boolTyCon +falseDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "False") falseDataConKey falseDataCon +trueDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "True") trueDataConKey trueDataCon listTyConName, nilDataConName, consDataConName :: Name listTyConName = mkWiredInTyConName BuiltInSyntax gHC_TYPES (fsLit "[]") listTyConKey listTyCon diff --git a/compiler/simplCore/SAT.lhs b/compiler/simplCore/SAT.lhs index 73ffba5..d398055 100644 --- a/compiler/simplCore/SAT.lhs +++ b/compiler/simplCore/SAT.lhs @@ -325,7 +325,7 @@ If we don't we get something like this: [Arity 3] GHC.Base.until = \ (@ a_aiK) - (p_a6T :: a_aiK -> GHC.Bool.Bool) + (p_a6T :: a_aiK -> GHC.Types.Bool) (f_a6V :: a_aiK -> a_aiK) (x_a6X :: a_aiK) -> letrec { @@ -335,17 +335,17 @@ GHC.Base.until = \ (x_a6X :: a_aiK) -> let { sat_shadow_r17 :: forall a_a3O. - (a_a3O -> GHC.Bool.Bool) -> (a_a3O -> a_a3O) -> a_a3O -> a_a3O + (a_a3O -> GHC.Types.Bool) -> (a_a3O -> a_a3O) -> a_a3O -> a_a3O [] sat_shadow_r17 = \ (@ a_aiK) - (p_a6T :: a_aiK -> GHC.Bool.Bool) + (p_a6T :: a_aiK -> GHC.Types.Bool) (f_a6V :: a_aiK -> a_aiK) (x_a6X :: a_aiK) -> sat_worker_s1aU x_a6X } in case p_a6T x_a6X of wild_X3y [ALWAYS Dead Nothing] { - GHC.Bool.False -> GHC.Base.until @ a_aiK p_a6T f_a6V (f_a6V x_a6X); - GHC.Bool.True -> x_a6X + GHC.Types.False -> GHC.Base.until @ a_aiK p_a6T f_a6V (f_a6V x_a6X); + GHC.Types.True -> x_a6X }; } in sat_worker_s1aU x_a6X diff --git a/rts/Exception.cmm b/rts/Exception.cmm index f85e2e9..581dafd 100644 --- a/rts/Exception.cmm +++ b/rts/Exception.cmm @@ -13,7 +13,7 @@ #include "Cmm.h" #include "RaiseAsync.h" -import ghczmprim_GHCziBool_True_closure; +import ghczmprim_GHCziTypes_True_closure; /* ----------------------------------------------------------------------------- Exception Primitives @@ -498,8 +498,8 @@ retry_pop_stack: Sp(5) = exception; Sp(4) = stg_raise_ret_info; Sp(3) = exception; // the AP_STACK - Sp(2) = ghczmprim_GHCziBool_True_closure; // dummy breakpoint info - Sp(1) = ghczmprim_GHCziBool_True_closure; // True <=> a breakpoint + Sp(2) = ghczmprim_GHCziTypes_True_closure; // dummy breakpoint info + Sp(1) = ghczmprim_GHCziTypes_True_closure; // True <=> a breakpoint R1 = ioAction; jump RET_LBL(stg_ap_pppv); } diff --git a/rts/Prelude.h b/rts/Prelude.h index 33a9148..86bb609 100644 --- a/rts/Prelude.h +++ b/rts/Prelude.h @@ -24,8 +24,8 @@ * modules these names are defined in. */ -PRELUDE_CLOSURE(ghczmprim_GHCziBool_True_closure); -PRELUDE_CLOSURE(ghczmprim_GHCziBool_False_closure); +PRELUDE_CLOSURE(ghczmprim_GHCziTypes_True_closure); +PRELUDE_CLOSURE(ghczmprim_GHCziTypes_False_closure); PRELUDE_CLOSURE(base_GHCziPack_unpackCString_closure); PRELUDE_CLOSURE(base_GHCziWeak_runFinalizzerBatch_closure); @@ -82,8 +82,8 @@ PRELUDE_INFO(base_GHCziWord_W64zh_con_info); PRELUDE_INFO(base_GHCziStable_StablePtr_static_info); PRELUDE_INFO(base_GHCziStable_StablePtr_con_info); -#define True_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziBool_True_closure) -#define False_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziBool_False_closure) +#define True_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziTypes_True_closure) +#define False_closure DLL_IMPORT_DATA_REF(ghczmprim_GHCziTypes_False_closure) #define unpackCString_closure DLL_IMPORT_DATA_REF(base_GHCziPack_unpackCString_closure) #define runFinalizerBatch_closure DLL_IMPORT_DATA_REF(base_GHCziWeak_runFinalizzerBatch_closure) #define mainIO_closure (&ZCMain_main_closure) diff --git a/rts/PrimOps.cmm b/rts/PrimOps.cmm index 1cc9544..4c41df7 100644 --- a/rts/PrimOps.cmm +++ b/rts/PrimOps.cmm @@ -34,7 +34,7 @@ import pthread_mutex_unlock; import base_ControlziExceptionziBase_nestedAtomically_closure; import EnterCriticalSection; import LeaveCriticalSection; -import ghczmprim_GHCziBool_False_closure; +import ghczmprim_GHCziTypes_False_closure; #if !defined(mingw32_HOST_OS) import sm_mutex; #endif @@ -2014,13 +2014,13 @@ stg_getSparkzh W_ spark; #ifndef THREADED_RTS - RET_NP(0,ghczmprim_GHCziBool_False_closure); + RET_NP(0,ghczmprim_GHCziTypes_False_closure); #else (spark) = foreign "C" findSpark(MyCapability()); if (spark != 0) { RET_NP(1,spark); } else { - RET_NP(0,ghczmprim_GHCziBool_False_closure); + RET_NP(0,ghczmprim_GHCziTypes_False_closure); } #endif } diff --git a/rts/package.conf.in b/rts/package.conf.in index ab5a723..0cc6313 100644 --- a/rts/package.conf.in +++ b/rts/package.conf.in @@ -83,8 +83,8 @@ ld-options: , "-u", "_base_GHCziPtr_Ptr_con_info" , "-u", "_base_GHCziPtr_FunPtr_con_info" , "-u", "_base_GHCziStable_StablePtr_con_info" - , "-u", "_ghczmprim_GHCziBool_False_closure" - , "-u", "_ghczmprim_GHCziBool_True_closure" + , "-u", "_ghczmprim_GHCziTypes_False_closure" + , "-u", "_ghczmprim_GHCziTypes_True_closure" , "-u", "_base_GHCziPack_unpackCString_closure" , "-u", "_base_GHCziIOziException_stackOverflow_closure" , "-u", "_base_GHCziIOziException_heapOverflow_closure" @@ -121,8 +121,8 @@ ld-options: , "-u", "base_GHCziPtr_Ptr_con_info" , "-u", "base_GHCziPtr_FunPtr_con_info" , "-u", "base_GHCziStable_StablePtr_con_info" - , "-u", "ghczmprim_GHCziBool_False_closure" - , "-u", "ghczmprim_GHCziBool_True_closure" + , "-u", "ghczmprim_GHCziTypes_False_closure" + , "-u", "ghczmprim_GHCziTypes_True_closure" , "-u", "base_GHCziPack_unpackCString_closure" , "-u", "base_GHCziIOziException_stackOverflow_closure" , "-u", "base_GHCziIOziException_heapOverflow_closure" diff --git a/rts/win32/libHSghc-prim.def b/rts/win32/libHSghc-prim.def index b1285cc..5146bd9 100644 --- a/rts/win32/libHSghc-prim.def +++ b/rts/win32/libHSghc-prim.def @@ -3,8 +3,8 @@ LIBRARY "libHSghc-prim-@LibVersion@-ghc@ProjectVersion@.dll" EXPORTS - ghczmprim_GHCziBool_True_closure - ghczmprim_GHCziBool_False_closure + ghczmprim_GHCziTypes_True_closure + ghczmprim_GHCziTypes_False_closure ghczmprim_GHCziTypes_Czh_con_info ghczmprim_GHCziTypes_Izh_con_info ghczmprim_GHCziTypes_Fzh_con_info diff --git a/utils/genprimopcode/Main.hs b/utils/genprimopcode/Main.hs index 2f7a287..3d7c83f 100644 --- a/utils/genprimopcode/Main.hs +++ b/utils/genprimopcode/Main.hs @@ -132,7 +132,7 @@ gen_hs_source (Info defaults entries) = ++ unlines (map (("\t" ++) . hdr) entries) ++ ") where\n" ++ "\n" - ++ "import GHC.Bool\n" + ++ "import GHC.Types\n" ++ "\n" ++ "{-\n" ++ unlines (map opt defaults) @@ -487,7 +487,7 @@ gen_wrappers (Info _ entries) -- don't need the Prelude here so we add NoImplicitPrelude. ++ "module GHC.PrimopWrappers where\n" ++ "import qualified GHC.Prim\n" - ++ "import GHC.Bool (Bool)\n" + ++ "import GHC.Types (Bool)\n" ++ "import GHC.Unit ()\n" ++ "import GHC.Prim (" ++ types ++ ")\n" ++ unlines (concatMap f specs) -- 1.7.10.4