From 30a08433b46de89511fcdf0149f0749739227efb Mon Sep 17 00:00:00 2001
From: Ian Lynagh <igloo@earth.li>
Date: Wed, 22 Jul 2009 15:10:48 +0000
Subject: [PATCH] Make the Integer library used directly configurable in GHC
and base Rather than indirecting through an integer package
---
compiler/basicTypes/Module.lhs | 3 ++-
compiler/ghc.mk | 2 ++
compiler/ghci/RtClosureInspect.hs | 11 +++++++----
compiler/prelude/PrelNames.lhs | 10 +++++-----
ghc.mk | 8 +++++---
packages | 1 -
6 files changed, 21 insertions(+), 14 deletions(-)
diff --git a/compiler/basicTypes/Module.lhs b/compiler/basicTypes/Module.lhs
index 9afef942e719..2eebf658ae3f 100644
--- a/compiler/basicTypes/Module.lhs
+++ b/compiler/basicTypes/Module.lhs
@@ -69,6 +69,7 @@ module Module
emptyModuleSet, mkModuleSet, moduleSetElts, extendModuleSet, elemModuleSet
) where
+import Config
import Outputable
import qualified Pretty
import Unique
@@ -319,7 +320,7 @@ integerPackageId, primPackageId,
thPackageId, dphSeqPackageId, dphParPackageId,
mainPackageId :: PackageId
primPackageId = fsToPackageId (fsLit "ghc-prim")
-integerPackageId = fsToPackageId (fsLit "integer")
+integerPackageId = fsToPackageId (fsLit cIntegerLibrary)
basePackageId = fsToPackageId (fsLit "base")
rtsPackageId = fsToPackageId (fsLit "rts")
haskell98PackageId = fsToPackageId (fsLit "haskell98")
diff --git a/compiler/ghc.mk b/compiler/ghc.mk
index 59b451dd3f00..64b1213c080f 100644
--- a/compiler/ghc.mk
+++ b/compiler/ghc.mk
@@ -51,6 +51,8 @@ $(compiler_CONFIG_HS) : mk/config.mk mk/project.mk
@echo "cBooterVersion = \"$(GhcVersion)\"" >> $@
@echo "cStage :: String" >> $@
@echo "cStage = show (STAGE :: Int)" >> $@
+ @echo "cIntegerLibrary :: String" >> $@
+ @echo "cIntegerLibrary = \"$(INTEGER_LIBRARY)\"" >> $@
@echo "cSplitObjs :: String" >> $@
@echo "cSplitObjs = \"$(SupportsSplitObjs)\"" >> $@
@echo "cGhcWithInterpreter :: String" >> $@
diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs
index 76ef9be1f7c8..cc1604761634 100644
--- a/compiler/ghci/RtClosureInspect.hs
+++ b/compiler/ghci/RtClosureInspect.hs
@@ -385,10 +385,8 @@ pprNewtypeWrap y p NewtypeWrap{ty=ty, wrapped_term=t}
| Just (tc,_) <- tcSplitTyConApp_maybe ty
, ASSERT(isNewTyCon tc) True
, Just new_dc <- tyConSingleDataCon_maybe tc = do
- if integerDataConName == dataConName new_dc
- then return $ text $ show $ (unsafeCoerce# $ val t :: Integer)
- else do real_term <- y max_prec t
- return$ cparen (p >= app_prec) (ppr new_dc <+> real_term)
+ real_term <- y max_prec t
+ return $ cparen (p >= app_prec) (ppr new_dc <+> real_term)
pprNewtypeWrap _ _ _ = panic "pprNewtypeWrap"
-------------------------------------------------------
@@ -433,6 +431,7 @@ cPprTermBase y =
, ifTerm (isTyCon charTyCon . ty) (coerceShow$ \(a::Char)->a)
, ifTerm (isTyCon floatTyCon . ty) (coerceShow$ \(a::Float)->a)
, ifTerm (isTyCon doubleTyCon . ty) (coerceShow$ \(a::Double)->a)
+ , ifTerm (isIntegerTy . ty) (coerceShow$ \(a::Integer)->a)
]
where ifTerm pred f prec t@Term{}
| pred t = Just `liftM` f prec t
@@ -446,6 +445,10 @@ cPprTermBase y =
(tc,_) <- tcSplitTyConApp_maybe ty
return (a_tc == tc)
+ isIntegerTy ty = fromMaybe False $ do
+ (tc,_) <- tcSplitTyConApp_maybe ty
+ return (tyConName tc == integerTyConName)
+
coerceShow f _p = return . text . show . f . unsafeCoerce# . val
--Note pprinting of list terms is not lazy
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index af3a1d0498cf..67e79e28c794 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -111,7 +111,7 @@ basicKnownKeyNames
stringTyConName,
ratioDataConName,
ratioTyConName,
- integerTyConName, smallIntegerName, integerDataConName,
+ integerTyConName, smallIntegerName,
-- Classes. *Must* include:
-- classes that are grabbed by key (e.g., eqClassKey)
@@ -235,7 +235,7 @@ pRELUDE :: Module
pRELUDE = mkBaseModule_ pRELUDE_NAME
gHC_PRIM, gHC_TYPES, gHC_BOOL, gHC_UNIT, gHC_ORDERING, gHC_GENERICS, gHC_CLASSES, gHC_BASE, gHC_ENUM,
- gHC_SHOW, gHC_READ, gHC_NUM, gHC_INTEGER, gHC_LIST, gHC_PARR,
+ gHC_SHOW, gHC_READ, gHC_NUM, gHC_INTEGER, gHC_INTEGER_TYPE, gHC_LIST, gHC_PARR,
gHC_TUPLE, dATA_TUPLE, dATA_EITHER, dATA_STRING, dATA_FOLDABLE, dATA_TRAVERSABLE,
gHC_PACK, gHC_CONC, gHC_IO, gHC_IO_Exception,
gHC_ST, gHC_ARR, gHC_STABLE, gHC_ADDR, gHC_PTR, gHC_ERR, gHC_REAL,
@@ -255,6 +255,7 @@ 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_INTEGER_TYPE = mkIntegerModule (fsLit "GHC.Integer.Type")
gHC_LIST = mkBaseModule (fsLit "GHC.List")
gHC_PARR = mkBaseModule (fsLit "GHC.PArr")
gHC_TUPLE = mkPrimModule (fsLit "GHC.Tuple")
@@ -634,15 +635,14 @@ sndName = varQual dATA_TUPLE (fsLit "snd") sndIdKey
-- Module PrelNum
numClassName, fromIntegerName, minusName, negateName, plusIntegerName,
timesIntegerName,
- integerTyConName, integerDataConName, smallIntegerName :: Name
+ integerTyConName, smallIntegerName :: Name
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_INTEGER (fsLit "plusInteger") plusIntegerIdKey
timesIntegerName = varQual gHC_INTEGER (fsLit "timesInteger") timesIntegerIdKey
-integerTyConName = tcQual gHC_INTEGER (fsLit "Integer") integerTyConKey
-integerDataConName = conName gHC_INTEGER (fsLit "Integer") integerDataConKey
+integerTyConName = tcQual gHC_INTEGER_TYPE (fsLit "Integer") integerTyConKey
smallIntegerName = varQual gHC_INTEGER (fsLit "smallInteger") smallIntegerIdKey
-- PrelReal types and classes
diff --git a/ghc.mk b/ghc.mk
index c1a71ae5a4c8..b2701bf5cf59 100644
--- a/ghc.mk
+++ b/ghc.mk
@@ -297,8 +297,7 @@ define addPackage # args: $1 = package, $2 = condition
endef
$(eval $(call addPackage,ghc-prim))
-$(eval $(call addPackage,integer-gmp))
-$(eval $(call addPackage,integer))
+$(eval $(call addPackage,$(INTEGER_LIBRARY)))
$(eval $(call addPackage,base))
$(eval $(call addPackage,filepath))
$(eval $(call addPackage,array))
@@ -505,8 +504,11 @@ BUILD_DIRS += \
endif
endif
+ifeq "$(INTEGER_LIBRARY)" "integer-gmp"
+BUILD_DIRS += libraries/integer-gmp/gmp
+endif
+
BUILD_DIRS += \
- libraries/integer-gmp/gmp \
compiler \
$(GHC_HSC2HS_DIR) \
$(GHC_PKG_DIR) \
diff --git a/packages b/packages
index 3171bce9e635..2eea464899ba 100644
--- a/packages
+++ b/packages
@@ -33,7 +33,6 @@ libraries/ghc-prim packages/ghc-prim darcs
libraries/haskeline packages/haskeline darcs
libraries/haskell98 packages/haskell98 darcs
libraries/hpc packages/hpc darcs
-libraries/integer packages/integer darcs
libraries/integer-gmp packages/integer-gmp darcs
libraries/integer-simple packages/integer-simple darcs
libraries/mtl packages/mtl darcs
--
GitLab