Commit 30a08433 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Make the Integer library used directly configurable in GHC and base

Rather than indirecting through an integer package
parent 51984e25
......@@ -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")
......
......@@ -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" >> $@
......
......@@ -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
......
......@@ -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
......
......@@ -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) \
......
......@@ -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
......
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