From 30a08433b46de89511fcdf0149f0749739227efb Mon Sep 17 00:00:00 2001 From: Ian Lynagh 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 9afef94..2eebf65 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 59b451d..64b1213 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 76ef9be..cc16047 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 af3a1d0..67e79e2 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 c1a71ae..b2701bf 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 3171bce..2eea464 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 -- 1.7.10.4