Commit fcf6b22d authored by Ian Lynagh's avatar Ian Lynagh

Follow library changes

Integer, Bool and Unit/Inl/Inr are now in new packages integer
and ghc-prim.
parent 7f0471be
......@@ -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")
......
......@@ -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, "(->)")
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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.%
......
......@@ -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
......@@ -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
......
......@@ -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);
}
......
......@@ -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)
......
......@@ -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"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment