Follow library changes

Integer, Bool and Unit/Inl/Inr are now in new packages integer
and ghc-prim.

diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs
index 22941a2..fcfcbb1 100644 (file)
--- a/compiler/basicTypes/Module.lhs
+++ b/compiler/basicTypes/Module.lhs
@@ -28,6 +28,8 @@ module Module
         packageIdString,
 
        -- * Wired-in PackageIds
+       primPackageId,
+       integerPackageId,
        basePackageId,
        rtsPackageId,
        haskell98PackageId,
@@ -277,8 +279,11 @@ packageIdString = unpackFS . packageIdFS
 -- package that depends directly or indirectly on it (much as if you
 -- had used -ignore-package).
 
-basePackageId, rtsPackageId, haskell98PackageId, 
+integerPackageId, primPackageId,
+  basePackageId, rtsPackageId, haskell98PackageId,
   thPackageId, ndpPackageId, mainPackageId  :: PackageId
+primPackageId      = fsToPackageId FSLIT("ghc-prim")
+integerPackageId   = fsToPackageId FSLIT("integer")
 basePackageId      = fsToPackageId FSLIT("base")
 rtsPackageId      = fsToPackageId FSLIT("rts")
 haskell98PackageId = fsToPackageId FSLIT("haskell98")

diff --git a/compiler/coreSyn/ExternalCore.lhs b/compiler/coreSyn/ExternalCore.lhs
index 49a7753..576e03e 100644 (file)
--- a/compiler/coreSyn/ExternalCore.lhs
+++ b/compiler/coreSyn/ExternalCore.lhs
@@ -81,7 +81,7 @@ type Qual t = (Mname,t)
 type Id = String
 
 primMname :: Mname
-primMname = "base:GHC.Prim"
+primMname = "ghc-prim:GHC.Prim"
 
 tcArrow :: Qual Tcon
 tcArrow = (primMname, "(->)")

diff --git a/compiler/deSugar/DsUtils.lhs b/compiler/deSugar/DsUtils.lhs
index 5eb33c8..cf670cd 100644 (file)
--- a/compiler/deSugar/DsUtils.lhs
+++ b/compiler/deSugar/DsUtils.lhs
@@ -515,8 +515,8 @@ mkCharExpr c = mkConApp charDataCon [mkLit (MachChar c)]
 
 mkIntegerExpr i
   | inIntRange i        -- Small enough, so start from an Int
-    = do integer_dc <- dsLookupDataCon  smallIntegerDataConName
-         return (mkSmallIntegerLit integer_dc i)
+    = do integer_id <- dsLookupGlobalId smallIntegerName
+         return (mkSmallIntegerLit integer_id i)
 
 -- Special case for integral literals with a large magnitude:
 -- They are transformed into an expression involving only smaller
@@ -525,9 +525,9 @@ mkIntegerExpr i
   | otherwise = do       -- Big, so start from a string
       plus_id <- dsLookupGlobalId plusIntegerName
       times_id <- dsLookupGlobalId timesIntegerName
-      integer_dc <- dsLookupDataCon  smallIntegerDataConName
+      integer_id <- dsLookupGlobalId smallIntegerName
       let
-           lit i = mkSmallIntegerLit integer_dc i
+           lit i = mkSmallIntegerLit integer_id i
            plus a b  = Var plus_id  `App` a `App` b
            times a b = Var times_id `App` a `App` b
 
@@ -543,8 +543,8 @@ mkIntegerExpr i
 
       return (horner tARGET_MAX_INT i)
 
-mkSmallIntegerLit :: DataCon -> Integer -> CoreExpr
-mkSmallIntegerLit small_integer_data_con i = mkConApp small_integer_data_con [mkIntLit i]
+mkSmallIntegerLit :: Id -> Integer -> CoreExpr
+mkSmallIntegerLit small_integer i = mkApps (Var small_integer) [mkIntLit i]
 
 mkStringExpr str = mkStringExprFS (mkFastString str)
 

diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 2647a5f..bd421bd 100644 (file)
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -380,10 +380,12 @@ findWiredInPackages dflags pkgs preload this_package = do
   -- their canonical names (eg. base-1.0 ==> base).
   --
   let
-       wired_in_pkgids = [ basePackageId,
-                           rtsPackageId,
-                           haskell98PackageId,
-                           thPackageId,
+        wired_in_pkgids = [ primPackageId,
+                            integerPackageId,
+                            basePackageId,
+                            rtsPackageId,
+                            haskell98PackageId,
+                            thPackageId,
                             ndpPackageId ]
 
        wired_in_names = map packageIdString wired_in_pkgids

diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 21e3520..c324e95 100644 (file)
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -118,7 +118,7 @@ basicKnownKeyNames
        stringTyConName,
        ratioDataConName,
        ratioTyConName,
-       integerTyConName, smallIntegerDataConName, largeIntegerDataConName,
+       integerTyConName, smallIntegerName,
 
        --  Classes.  *Must* include:
        --      classes that are grabbed by key (e.g., eqClassKey)
@@ -236,12 +236,15 @@ genericTyConNames = [crossTyConName, plusTyConName, genUnitTyConName]
 --MetaHaskell Extension Add a new module here
 \begin{code}
 pRELUDE                = mkBaseModule_ pRELUDE_NAME
-gHC_PRIM       = mkBaseModule FSLIT("GHC.Prim")   -- Primitive types and values
+gHC_PRIM       = mkPrimModule FSLIT("GHC.Prim")   -- Primitive types and values
+gHC_BOOL       = mkPrimModule FSLIT("GHC.Bool")
+gHC_GENERICS   = mkPrimModule FSLIT("GHC.Generics")
 gHC_BASE       = mkBaseModule FSLIT("GHC.Base")
 gHC_ENUM       = mkBaseModule FSLIT("GHC.Enum")
 gHC_SHOW       = mkBaseModule FSLIT("GHC.Show")
 gHC_READ       = mkBaseModule FSLIT("GHC.Read")
 gHC_NUM                = mkBaseModule FSLIT("GHC.Num")
+gHC_INTEGER    = mkIntegerModule FSLIT("GHC.Integer")
 gHC_LIST       = mkBaseModule FSLIT("GHC.List")
 gHC_PARR       = mkBaseModule FSLIT("GHC.PArr")
 dATA_TUP       = mkBaseModule FSLIT("Data.Tuple")
@@ -288,6 +291,12 @@ thFAKE         = mkMainModule FSLIT(":THFake")
 pRELUDE_NAME   = mkModuleNameFS FSLIT("Prelude")
 mAIN_NAME      = mkModuleNameFS FSLIT("Main")
 
+mkPrimModule :: FastString -> Module
+mkPrimModule m = mkModule primPackageId (mkModuleNameFS m)
+
+mkIntegerModule :: FastString -> Module
+mkIntegerModule m = mkModule integerPackageId (mkModuleNameFS m)
+
 mkBaseModule :: FastString -> Module
 mkBaseModule m = mkModule basePackageId (mkModuleNameFS m)
 
@@ -439,10 +448,10 @@ mkTyConRep_RDR = varQual_RDR tYPEABLE FSLIT("mkTyCon")
 
 undefined_RDR = varQual_RDR gHC_ERR FSLIT("undefined")
 
-crossDataCon_RDR   = dataQual_RDR gHC_BASE FSLIT(":*:")
-inlDataCon_RDR     = dataQual_RDR gHC_BASE FSLIT("Inl")
-inrDataCon_RDR     = dataQual_RDR gHC_BASE FSLIT("Inr")
-genUnitDataCon_RDR = dataQual_RDR gHC_BASE FSLIT("Unit")
+crossDataCon_RDR   = dataQual_RDR gHC_GENERICS FSLIT(":*:")
+inlDataCon_RDR     = dataQual_RDR gHC_GENERICS FSLIT("Inl")
+inrDataCon_RDR     = dataQual_RDR gHC_GENERICS FSLIT("Inr")
+genUnitDataCon_RDR = dataQual_RDR gHC_GENERICS FSLIT("Unit")
 
 ----------------------
 varQual_RDR  mod str = mkOrig mod (mkOccNameFS varName str)
@@ -475,9 +484,9 @@ leftDataConName   = conName dATA_EITHER FSLIT("Left")   leftDataConKey
 rightDataConName  = conName dATA_EITHER FSLIT("Right")  rightDataConKey
 
 -- Generics
-crossTyConName     = tcQual   gHC_BASE FSLIT(":*:") crossTyConKey
-plusTyConName      = tcQual   gHC_BASE FSLIT(":+:") plusTyConKey
-genUnitTyConName   = tcQual   gHC_BASE FSLIT("Unit") genUnitTyConKey
+crossTyConName     = tcQual   gHC_GENERICS FSLIT(":*:") crossTyConKey
+plusTyConName      = tcQual   gHC_GENERICS FSLIT(":+:") plusTyConKey
+genUnitTyConName   = tcQual   gHC_GENERICS FSLIT("Unit") genUnitTyConKey
 
 -- Base strings Strings
 unpackCStringName       = varQual gHC_BASE FSLIT("unpackCString#") unpackCStringIdKey
@@ -548,11 +557,10 @@ numClassName        = clsQual  gHC_NUM FSLIT("Num") numClassKey
 fromIntegerName   = methName gHC_NUM FSLIT("fromInteger") fromIntegerClassOpKey
 minusName        = methName gHC_NUM FSLIT("-") minusClassOpKey
 negateName       = methName gHC_NUM FSLIT("negate") negateClassOpKey
-plusIntegerName   = varQual  gHC_NUM FSLIT("plusInteger") plusIntegerIdKey
-timesIntegerName  = varQual  gHC_NUM FSLIT("timesInteger") timesIntegerIdKey
-integerTyConName  = tcQual   gHC_NUM FSLIT("Integer") integerTyConKey
-smallIntegerDataConName = conName gHC_NUM FSLIT("S#") smallIntegerDataConKey
-largeIntegerDataConName = conName gHC_NUM FSLIT("J#") largeIntegerDataConKey
+plusIntegerName   = varQual  gHC_INTEGER FSLIT("plusInteger") plusIntegerIdKey
+timesIntegerName  = varQual  gHC_INTEGER FSLIT("timesInteger") timesIntegerIdKey
+integerTyConName  = tcQual   gHC_INTEGER FSLIT("Integer") integerTyConKey
+smallIntegerName = varQual gHC_INTEGER FSLIT("smallInteger") smallIntegerIdKey
 
 -- PrelReal types and classes
 rationalTyConName   = tcQual  gHC_REAL FSLIT("Rational") rationalTyConKey
@@ -889,8 +897,6 @@ doubleDataConKey                    = mkPreludeDataConUnique  3
 falseDataConKey                                = mkPreludeDataConUnique  4
 floatDataConKey                                = mkPreludeDataConUnique  5
 intDataConKey                          = mkPreludeDataConUnique  6
-smallIntegerDataConKey                 = mkPreludeDataConUnique  7
-largeIntegerDataConKey                 = mkPreludeDataConUnique  8
 nilDataConKey                          = mkPreludeDataConUnique 11
 ratioDataConKey                                = mkPreludeDataConUnique 12
 stableNameDataConKey                   = mkPreludeDataConUnique 14
@@ -957,6 +963,7 @@ bindIOIdKey               = mkPreludeMiscIdUnique 36
 returnIOIdKey                = mkPreludeMiscIdUnique 37
 deRefStablePtrIdKey          = mkPreludeMiscIdUnique 38
 newStablePtrIdKey            = mkPreludeMiscIdUnique 39
+smallIntegerIdKey                      = mkPreludeMiscIdUnique  40
 plusIntegerIdKey             = mkPreludeMiscIdUnique 41
 timesIntegerIdKey            = mkPreludeMiscIdUnique 42
 printIdKey                   = mkPreludeMiscIdUnique 43

diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 78d3583..ce9988b 100644 (file)
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -155,9 +155,9 @@ charDataConName   = mkWiredInDataConName UserSyntax gHC_BASE FSLIT("C#") charDat
 intTyConName     = mkWiredInTyConName   UserSyntax gHC_BASE FSLIT("Int") intTyConKey   intTyCon
 intDataConName   = mkWiredInDataConName UserSyntax gHC_BASE FSLIT("I#") intDataConKey  intDataCon
                                                  
-boolTyConName    = mkWiredInTyConName   UserSyntax gHC_BASE FSLIT("Bool") boolTyConKey boolTyCon
-falseDataConName  = mkWiredInDataConName UserSyntax gHC_BASE FSLIT("False") falseDataConKey falseDataCon
-trueDataConName          = mkWiredInDataConName UserSyntax gHC_BASE FSLIT("True")  trueDataConKey  trueDataCon 
+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 
 listTyConName    = mkWiredInTyConName   BuiltInSyntax gHC_BASE FSLIT("[]") listTyConKey listTyCon
 nilDataConName           = mkWiredInDataConName BuiltInSyntax gHC_BASE FSLIT("[]") nilDataConKey nilDataCon 
 consDataConName          = mkWiredInDataConName BuiltInSyntax gHC_BASE FSLIT(":") consDataConKey consDataCon

diff --git a/compiler/utils/Binary.hs b/compiler/utils/Binary.hs
index ad048b6..466a515 100644 (file)
--- a/compiler/utils/Binary.hs
+++ b/compiler/utils/Binary.hs
@@ -467,6 +467,14 @@ instance (Binary a, Binary b) => Binary (Either a b) where
 -- yes, we need Binary Integer and Binary Rational in basicTypes/Literal.lhs
 
 instance Binary Integer where
+    -- XXX This is hideous
+    put_ bh i = put_ bh (show i)
+    get bh = do str <- get bh
+                case reads str of
+                    [(i, "")] -> return i
+                    _ -> fail ("Binary Integer: got " ++ show str)
+
+    {-
     put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#)
     put_ bh (J# s# a#) = do
         putByte bh 1
@@ -484,6 +492,7 @@ instance Binary Integer where
                   sz <- get bh
                   (BA a#) <- getByteArray bh sz
                   return (J# s# a#)
+-}
 
 -- As for the rest of this code, even though this module
 -- exports it, it doesn't seem to be used anywhere else

diff --git a/libraries/Makefile b/libraries/Makefile
index c854108..9617dd4 100644 (file)
--- a/libraries/Makefile
+++ b/libraries/Makefile
@@ -38,7 +38,7 @@ show:
 TOP=..
 include $(TOP)/mk/boilerplate.mk
 
-SUBDIRS  = base array packedstring containers bytestring
+SUBDIRS  = ghc-prim integer-gmp base array packedstring containers bytestring
 SUBDIRS += old-locale old-time filepath directory
 ifeq "$(GhcLibsWithUnix)" "YES"
 SUBDIRS += unix
@@ -322,7 +322,8 @@ doc.library.%: stamp/configure.library.build$(CONFIGURE_STAMP_EXTRAS).% \
                                       $(CABAL_HADDOCK_FLAGS); \
        fi
 ifneq "$(HSCOLOUR)" ""
-       if ifBuildable/ifBuildable $*; then cp hscolour.css $*/dist/doc/html/$*/src/; fi
+# We use */src rather than $*/src due to the integer-gmp/integer mismatch
+       if ifBuildable/ifBuildable $*; then cp hscolour.css $*/dist/doc/html/*/src/; fi
 endif
 
 .PHONY: distclean clean clean.library.%

diff --git a/libraries/boot-packages b/libraries/boot-packages
index 940683d..6ffb54e 100644 (file)
--- a/libraries/boot-packages
+++ b/libraries/boot-packages
@@ -6,7 +6,10 @@ containers
 directory
 editline
 filepath
+ghc-prim
 haskell98
+hpc
+integer-gmp
 old-locale
 old-time
 packedstring
@@ -16,4 +19,3 @@ random
 template-haskell
 unix
 Win32
-hpc

diff --git a/libraries/installPackage.hs b/libraries/installPackage.hs
index df2a9e2..4615429 100644 (file)
--- a/libraries/installPackage.hs
+++ b/libraries/installPackage.hs
@@ -40,7 +40,7 @@ doRegisterInplace verbosity =
        do lbi <- getConfig verbosity
           let registerFlags = defaultRegisterFlags { regInPlace = toFlag True }
               pd = localPkgDescr lbi
-              pd_reg = if pkgName (package pd) == "base"
+              pd_reg = if pkgName (package pd) == "ghc-prim"
                        then case library pd of
                             Just lib ->
                                 let ems = "GHC.Prim" : exposedModules lib
@@ -75,9 +75,9 @@ doInstall verbosity ghcpkg ghcpkgconf destdir topdir
           let pd = localPkgDescr lbi
               i = installDirTemplates lbi
               -- This is an almighty hack. We need to register
-              -- base:GHC.Prim, but it doesn't exist, get built, get
+              -- ghc-prim:GHC.Prim, but it doesn't exist, get built, get
               -- haddocked, get copied, etc.
-              pd_reg = if pkgName (package pd) == "base"
+              pd_reg = if pkgName (package pd) == "ghc-prim"
                        then case library pd of
                             Just lib ->
                                 let ems = "GHC.Prim" : exposedModules lib

diff --git a/rts/Exception.cmm b/rts/Exception.cmm
index 39a2aba..c2f0dde 100644 (file)
--- a/rts/Exception.cmm
+++ b/rts/Exception.cmm
@@ -14,7 +14,7 @@
 #include "RaiseAsync.h"
 
 #ifdef __PIC__
-import base_GHCziBase_True_closure;
+import ghczmprim_GHCziBool_True_closure;
 #endif
 
 /* -----------------------------------------------------------------------------
@@ -440,8 +440,8 @@ retry_pop_stack:
             Sp(5) = stg_raise_ret_info;
             Sp(4) = stg_noforceIO_info;    // required for unregisterised
             Sp(3) = exception;             // the AP_STACK
-            Sp(2) = base_GHCziBase_True_closure; // dummy breakpoint info
-            Sp(1) = base_GHCziBase_True_closure; // True <=> a breakpoint
+            Sp(2) = ghczmprim_GHCziBool_True_closure; // dummy breakpoint info
+            Sp(1) = ghczmprim_GHCziBool_True_closure; // True <=> a breakpoint
             R1 = ioAction;
             jump RET_LBL(stg_ap_pppv);
         }

diff --git a/rts/Prelude.h b/rts/Prelude.h
index 31fe136..f237e59 100644 (file)
--- a/rts/Prelude.h
+++ b/rts/Prelude.h
@@ -24,8 +24,8 @@
  * modules these names are defined in.
  */
 
-PRELUDE_CLOSURE(base_GHCziBase_True_closure);
-PRELUDE_CLOSURE(base_GHCziBase_False_closure);
+PRELUDE_CLOSURE(ghczmprim_GHCziBool_True_closure);
+PRELUDE_CLOSURE(ghczmprim_GHCziBool_False_closure);
 PRELUDE_CLOSURE(base_GHCziPack_unpackCString_closure);
 PRELUDE_CLOSURE(base_GHCziWeak_runFinalizzerBatch_closure);
 
@@ -79,8 +79,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(base_GHCziBase_True_closure)
-#define False_closure             DLL_IMPORT_DATA_REF(base_GHCziBase_False_closure)
+#define True_closure              DLL_IMPORT_DATA_REF(ghczmprim_GHCziBool_True_closure)
+#define False_closure             DLL_IMPORT_DATA_REF(ghczmprim_GHCziBool_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/package.conf.in b/rts/package.conf.in
index f73e6b1..1642101 100644 (file)
--- a/rts/package.conf.in
+++ b/rts/package.conf.in
@@ -101,8 +101,8 @@ ld-options:
          , "-u", "_base_GHCziPtr_Ptr_con_info"
          , "-u", "_base_GHCziPtr_FunPtr_con_info"
          , "-u", "_base_GHCziStable_StablePtr_con_info"
-         , "-u", "_base_GHCziBase_False_closure"
-         , "-u", "_base_GHCziBase_True_closure"
+         , "-u", "_ghczmprim_GHCziBool_False_closure"
+         , "-u", "_ghczmprim_GHCziBool_True_closure"
          , "-u", "_base_GHCziPack_unpackCString_closure"
          , "-u", "_base_GHCziIOBase_stackOverflow_closure"
          , "-u", "_base_GHCziIOBase_heapOverflow_closure"
@@ -135,8 +135,8 @@ ld-options:
          , "-u", "base_GHCziPtr_Ptr_con_info"
          , "-u", "base_GHCziPtr_FunPtr_con_info"
          , "-u", "base_GHCziStable_StablePtr_con_info"
-         , "-u", "base_GHCziBase_False_closure"
-         , "-u", "base_GHCziBase_True_closure"
+         , "-u", "ghczmprim_GHCziBool_False_closure"
+         , "-u", "ghczmprim_GHCziBool_True_closure"
          , "-u", "base_GHCziPack_unpackCString_closure"
          , "-u", "base_GHCziIOBase_stackOverflow_closure"
          , "-u", "base_GHCziIOBase_heapOverflow_closure"