From be2c67eb19565e8d0d9ca5a53f526ce49acf1d92 Mon Sep 17 00:00:00 2001 From: simonpj Date: Thu, 22 Feb 2001 13:17:59 +0000 Subject: [PATCH] [project @ 2001-02-22 13:17:57 by simonpj] fromInt Remove fromInt from class Num, though it is retained as an overloaded operation (with unchanged type) in PrelNum. There are quite a few consequential changes in the Prelude. I hope I got them all correct! Also fix a bug that meant Integer (and its instances) wasn't getting slurped in by the renamer, even though it was needed for defaulting. --- ghc/compiler/prelude/PrelNames.lhs | 14 +++++--------- ghc/compiler/rename/RnEnv.lhs | 35 +++++++++++++++++++++++------------ ghc/compiler/rename/RnExpr.lhs | 7 +++++-- ghc/compiler/rename/RnIfaces.lhs | 17 +++-------------- ghc/compiler/typecheck/Inst.lhs | 8 +------- ghc/compiler/typecheck/TcEnv.lhs | 2 +- ghc/compiler/typecheck/TcModule.lhs | 1 + ghc/lib/std/CPUTime.lhs | 4 ++-- ghc/lib/std/Numeric.lhs | 4 ++-- ghc/lib/std/PrelByteArr.lhs | 3 ++- ghc/lib/std/PrelCTypes.lhs | 3 +-- ghc/lib/std/PrelCTypesISO.lhs | 3 +-- ghc/lib/std/PrelFloat.lhs | 26 ++++++++++++-------------- ghc/lib/std/PrelHandle.lhs | 6 +++--- ghc/lib/std/PrelIOBase.lhs | 14 ++++++++++---- ghc/lib/std/PrelInt.lhs | 12 +++++------- ghc/lib/std/PrelNum.lhs | 12 +++++------- ghc/lib/std/PrelRead.lhs | 4 ++-- ghc/lib/std/PrelReal.lhs | 4 ++-- ghc/lib/std/PrelST.lhs | 4 ++-- ghc/lib/std/PrelWord.lhs | 5 ----- ghc/lib/std/Prelude.lhs | 3 +-- ghc/lib/std/Random.lhs | 5 ++--- ghc/lib/std/cbits/CTypes.h | 5 ++--- 24 files changed, 93 insertions(+), 108 deletions(-) diff --git a/ghc/compiler/prelude/PrelNames.lhs b/ghc/compiler/prelude/PrelNames.lhs index cf2e96d..b0ca305 100644 --- a/ghc/compiler/prelude/PrelNames.lhs +++ b/ghc/compiler/prelude/PrelNames.lhs @@ -109,7 +109,6 @@ knownKeyNames cReturnableClassName, -- mentioned, ccallish -- ClassOps - fromIntName, fromIntegerName, negateName, geName, @@ -376,7 +375,6 @@ readClassName = clsQual pREL_READ_Name SLIT("Read") readClassKey -- Module PrelNum numClassName = clsQual pREL_NUM_Name SLIT("Num") numClassKey -fromIntName = varQual pREL_NUM_Name SLIT("fromInt") fromIntClassOpKey fromIntegerName = varQual pREL_NUM_Name SLIT("fromInteger") fromIntegerClassOpKey minusName = varQual pREL_NUM_Name SLIT("-") minusClassOpKey negateName = varQual pREL_NUM_Name SLIT("negate") negateClassOpKey @@ -808,7 +806,6 @@ uniques so we can look them up easily when we want to conjure them up during type checking. \begin{code} -fromIntClassOpKey = mkPreludeMiscIdUnique 101 fromIntegerClassOpKey = mkPreludeMiscIdUnique 102 minusClassOpKey = mkPreludeMiscIdUnique 103 fromRationalClassOpKey = mkPreludeMiscIdUnique 104 @@ -882,10 +879,10 @@ cCallishTyKeys = %* * %************************************************************************ -Haskell 98 says that when you say "3" you get the "fromInt" from the +Haskell 98 says that when you say "3" you get the "fromInteger" from the Standard Prelude, regardless of what is in scope. However, to experiment with having a language that is less coupled to the standard prelude, we're -trying a non-standard extension that instead gives you whatever "Prelude.fromInt" +trying a non-standard extension that instead gives you whatever "Prelude.fromInteger" happens to be in scope. Then you can import Prelude () import MyPrelude as Prelude @@ -902,8 +899,7 @@ type SyntaxList = [(Name, RdrName)] -- to a RdrName for the re-mapped version of the built-in thing syntaxList :: SyntaxList -syntaxList =[ (fromIntName, mkUnqual varName SLIT("fromInt")) - , (fromIntegerName, mkUnqual varName SLIT("fromInteger")) +syntaxList =[ (fromIntegerName, mkUnqual varName SLIT("fromInteger")) , (fromRationalName, mkUnqual varName SLIT("fromRational")) , (negateName, mkUnqual varName SLIT("negate")) , (minusName, mkUnqual varName SLIT("-")) @@ -912,8 +908,8 @@ syntaxList =[ (fromIntName, mkUnqual varName SLIT("fromInt")) type SyntaxMap = Name -> Name - -- Maps a standard built-in name, such as PrelNum.fromInt - -- to its re-mapped version, such as MyPrelude.fromInt + -- Maps a standard built-in name, such as PrelNum.fromInteger + -- to its re-mapped version, such as MyPrelude.fromInteger vanillaSyntaxMap name = name \end{code} diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs index f87d584..9005d08 100644 --- a/ghc/compiler/rename/RnEnv.lhs +++ b/ghc/compiler/rename/RnEnv.lhs @@ -35,15 +35,16 @@ import NameSet import OccName ( OccName, occNameUserString, occNameFlavour ) import Module ( ModuleName, moduleName, mkVanillaModule, mkSysModuleNameFS, moduleNameFS, WhereFrom(..) ) -import TysWiredIn ( unitTyCon, intTyCon, boolTyCon, integerTyCon ) -import Type ( funTyCon ) import PrelNames ( mkUnboundName, syntaxList, SyntaxMap, vanillaSyntaxMap, derivingOccurrences, mAIN_Name, pREL_MAIN_Name, - ioTyConName, printName, + ioTyConName, integerTyConName, doubleTyConName, intTyConName, + boolTyConName, funTyConName, unpackCStringName, unpackCStringFoldrName, unpackCStringUtf8Name, - eqStringName + eqStringName, printName, + hasKey, fractionalClassKey, numClassKey ) +import TysWiredIn ( unitTyCon ) -- A little odd import FiniteMap import UniqSupply import SrcLoc ( SrcLoc, noSrcLoc ) @@ -399,15 +400,25 @@ ubiquitousNames -- Virtually every program has error messages in it somewhere `plusFV` - mkFVs (map getName [unitTyCon, funTyCon, boolTyCon, intTyCon, integerTyCon]) - -- Add occurrences for Integer, and (), because they - -- are the types to which ambigious type variables may be defaulted by - -- the type checker; so they won't always appear explicitly. - -- [The () one is a GHC extension for defaulting CCall results.] - -- ALSO: funTyCon, since it occurs implicitly everywhere! - -- (we don't want to be bothered with making funTyCon a + mkFVs [getName unitTyCon, funTyConName, boolTyConName, intTyConName] + -- Add occurrences for very frequently used types. + -- (e.g. we don't want to be bothered with making funTyCon a -- free var at every function application!) - -- Double is dealt with separately in getGates +\end{code} + +\begin{code} +implicitGates :: Name -> FreeVars +-- If we load class Num, add Integer to the gates +-- This takes account of the fact that Integer might be needed for +-- defaulting, but we don't want to load Integer (and all its baggage) +-- if there's no numeric stuff needed. +-- Similarly for class Fractional and Double +-- +-- NB: If we load (say) Floating, we'll end up loading Fractional too, +-- since Fractional is a superclass of Floating +implicitGates cls | cls `hasKey` numClassKey = unitFV integerTyConName + | cls `hasKey` fractionalClassKey = unitFV doubleTyConName + | otherwise = emptyFVs \end{code} \begin{code} diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs index 5cd7e5f..8e60af9 100644 --- a/ghc/compiler/rename/RnExpr.lhs +++ b/ghc/compiler/rename/RnExpr.lhs @@ -29,7 +29,7 @@ import RnHiFiles ( lookupFixityRn ) import CmdLineOpts ( DynFlag(..), opt_IgnoreAsserts ) import Literal ( inIntRange ) import BasicTypes ( Fixity(..), FixityDirection(..), defaultFixity, negateFixity ) -import PrelNames ( hasKey, assertIdKey, minusName, negateName, fromIntName, +import PrelNames ( hasKey, assertIdKey, minusName, negateName, fromIntegerName, eqClass_RDR, foldr_RDR, build_RDR, eqString_RDR, cCallableClass_RDR, cReturnableClass_RDR, monadClass_RDR, enumClass_RDR, ordClass_RDR, @@ -825,10 +825,13 @@ litFVs lit = pprPanic "RnExpr.litFVs" (ppr lit) -- HsInteger and HsRat on rnOverLit (HsIntegral i) | inIntRange i - = returnRn (HsIntegral i, unitFV fromIntName) + = returnRn (HsIntegral i, unitFV fromIntegerName) | otherwise = lookupOrigNames [fromInteger_RDR, plusInteger_RDR, timesInteger_RDR] `thenRn` \ ns -> -- Big integers are built, using + and *, out of small integers + -- [No particular reason why we use fromIntegerName in one case can + -- fromInteger_RDR in the other; but plusInteger_RDR means we + -- can get away without plusIntegerName altogether.] returnRn (HsIntegral i, ns) rnOverLit (HsFractional i) diff --git a/ghc/compiler/rename/RnIfaces.lhs b/ghc/compiler/rename/RnIfaces.lhs index a81e8b6..d0d16e2 100644 --- a/ghc/compiler/rename/RnIfaces.lhs +++ b/ghc/compiler/rename/RnIfaces.lhs @@ -38,7 +38,7 @@ import Id ( idType ) import Type ( namesOfType ) import TyCon ( isSynTyCon, getSynTyConDefn ) import Name ( Name {-instance NamedThing-}, nameOccName, - nameModule, isLocalName, nameUnique, + nameModule, isLocalName, NamedThing(..) ) import Name ( elemNameEnv, delFromNameEnv ) @@ -50,8 +50,7 @@ import Module ( Module, ModuleEnv, elemModuleSet, extendModuleSet ) import NameSet -import PrelInfo ( wiredInThingEnv, fractionalClassKeys ) -import TysWiredIn ( doubleTyCon ) +import PrelInfo ( wiredInThingEnv ) import Maybes ( orElse ) import FiniteMap import Outputable @@ -405,22 +404,12 @@ get_gates is_used (ClassDecl { tcdCtxt = ctxt, tcdName = cls, tcdTyVars = tvs, t = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs) (hsTyVarNames tvs) `addOneToNameSet` cls) - `plusFV` maybe_double + `plusFV` implicitGates cls where get (ClassOpSig n _ ty _) | is_used n = extractHsTyNames ty | otherwise = emptyFVs - -- If we load any numeric class that doesn't have - -- Int as an instance, add Double to the gates. - -- This takes account of the fact that Double might be needed for - -- defaulting, but we don't want to load Double (and all its baggage) - -- if the more exotic classes aren't used at all. - maybe_double | nameUnique cls `elem` fractionalClassKeys - = unitFV (getName doubleTyCon) - | otherwise - = emptyFVs - get_gates is_used (TySynonym {tcdTyVars = tvs, tcdSynRhs = ty}) = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs) -- A type synonym type constructor isn't a "gate" for instance decls diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs index 762cdec..0652f81 100644 --- a/ghc/compiler/typecheck/Inst.lhs +++ b/ghc/compiler/typecheck/Inst.lhs @@ -71,7 +71,7 @@ import TysWiredIn ( isIntTy, doubleDataCon, isDoubleTy, isIntegerTy ) -import PrelNames( fromIntName, fromIntegerName, fromRationalName ) +import PrelNames( fromIntegerName, fromRationalName ) import Util ( thenCmp, zipWithEqual, mapAccumL ) import Bag import Outputable @@ -626,12 +626,6 @@ lookupInst inst@(LitInst u (HsIntegral i) ty loc) | isIntegerTy ty -- Short cut for Integer = returnNF_Tc (GenInst [] integer_lit) - | in_int_range -- It's overloaded but small enough to fit into an Int - = -- So we can use the Prelude fromInt - tcLookupSyntaxId fromIntName `thenNF_Tc` \ from_int -> - newMethodAtLoc loc from_int [ty] `thenNF_Tc` \ (method_inst, method_id) -> - returnNF_Tc (GenInst [method_inst] (HsApp (HsVar method_id) int_lit)) - | otherwise -- Alas, it is overloaded and a big literal! = tcLookupSyntaxId fromIntegerName `thenNF_Tc` \ from_integer -> newMethodAtLoc loc from_integer [ty] `thenNF_Tc` \ (method_inst, method_id) -> diff --git a/ghc/compiler/typecheck/TcEnv.lhs b/ghc/compiler/typecheck/TcEnv.lhs index 0192bba..ac92dc3 100644 --- a/ghc/compiler/typecheck/TcEnv.lhs +++ b/ghc/compiler/typecheck/TcEnv.lhs @@ -351,7 +351,7 @@ tcLookupLocalIds ns tcLookupSyntaxId :: Name -> NF_TcM Id -- Lookup a name like PrelNum.fromInt, and return the corresponding Id, -- after mapping through the SyntaxMap. This may give us the Id for --- (say) MyPrelude.fromInt +-- (say) MyPrelude.fromInteger tcLookupSyntaxId name = tcGetEnv `thenNF_Tc` \ env -> returnNF_Tc (case lookup_global env (tcSyntaxMap env name) of diff --git a/ghc/compiler/typecheck/TcModule.lhs b/ghc/compiler/typecheck/TcModule.lhs index e1a3e0e..4718587 100644 --- a/ghc/compiler/typecheck/TcModule.lhs +++ b/ghc/compiler/typecheck/TcModule.lhs @@ -232,6 +232,7 @@ tcModule pcs hst get_fixity this_mod decls check_main -- Value declarations next. -- We also typecheck any extra binds that came out of the "deriving" process + traceTc (text "Default types" <+> ppr defaulting_tys) `thenNF_Tc_` traceTc (text "Tc5") `thenNF_Tc_` tcTopBinds (val_binds `ThenBinds` deriv_binds) `thenTc` \ ((val_binds, env), lie_valdecls) -> diff --git a/ghc/lib/std/CPUTime.lhs b/ghc/lib/std/CPUTime.lhs index c5c7bc7..df37a04 100644 --- a/ghc/lib/std/CPUTime.lhs +++ b/ghc/lib/std/CPUTime.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $Id: CPUTime.lhs,v 1.27 2001/01/11 17:25:57 simonmar Exp $ +% $Id: CPUTime.lhs,v 1.28 2001/02/22 13:17:58 simonpj Exp $ % % (c) The University of Glasgow, 1995-2000 % @@ -60,7 +60,7 @@ getCPUTime = do cpuTimePrecision :: Integer cpuTimePrecision = round ((1000000000000::Integer) % - fromInt (unsafePerformIO clockTicks)) + fromIntegral (unsafePerformIO clockTicks)) foreign import "libHS_cbits" "getCPUTime" unsafe primGetCPUTime :: ByteArray Int -> IO Int foreign import "libHS_cbits" "clockTicks" unsafe clockTicks :: IO Int diff --git a/ghc/lib/std/Numeric.lhs b/ghc/lib/std/Numeric.lhs index 7bc8869..974c84b 100644 --- a/ghc/lib/std/Numeric.lhs +++ b/ghc/lib/std/Numeric.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $Id: Numeric.lhs,v 1.10 2000/12/16 17:46:57 qrczak Exp $ +% $Id: Numeric.lhs,v 1.11 2001/02/22 13:17:58 simonpj Exp $ % % (c) The University of Glasgow, 1997-2000 % @@ -307,7 +307,7 @@ floatToDigits base x = (p - 1 + e0) * 3 `div` 10 else ceiling ((log (fromInteger (f+1)) + - fromInt e * log (fromInteger b)) / + fromIntegral e * log (fromInteger b)) / log (fromInteger base)) fixup n = if n >= 0 then diff --git a/ghc/lib/std/PrelByteArr.lhs b/ghc/lib/std/PrelByteArr.lhs index 04e0b1a..9662dbd 100644 --- a/ghc/lib/std/PrelByteArr.lhs +++ b/ghc/lib/std/PrelByteArr.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $Id: PrelByteArr.lhs,v 1.11 2001/02/20 18:40:54 qrczak Exp $ +% $Id: PrelByteArr.lhs,v 1.12 2001/02/22 13:17:58 simonpj Exp $ % % (c) The University of Glasgow, 1994-2000 % @@ -14,6 +14,7 @@ Byte-arrays are flat arrays of non-pointers only. module PrelByteArr where import {-# SOURCE #-} PrelErr ( error ) +import PrelNum import PrelArr import PrelFloat import PrelST diff --git a/ghc/lib/std/PrelCTypes.lhs b/ghc/lib/std/PrelCTypes.lhs index 8335fc9..ea23afe 100644 --- a/ghc/lib/std/PrelCTypes.lhs +++ b/ghc/lib/std/PrelCTypes.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $Id: PrelCTypes.lhs,v 1.1 2001/01/11 17:25:57 simonmar Exp $ +% $Id: PrelCTypes.lhs,v 1.2 2001/02/22 13:17:58 simonpj Exp $ % % (c) The FFI task force, 2000 % @@ -25,7 +25,6 @@ module PrelCTypes \begin{code} import PrelBase ( unsafeCoerce# ) import PrelReal ( Integral(toInt) ) -import PrelNum ( Num(fromInt) ) import PrelBits ( Bits(..) ) import PrelInt ( Int8, Int16, Int32, Int64 ) import PrelWord ( Word8, Word16, Word32, Word64 ) diff --git a/ghc/lib/std/PrelCTypesISO.lhs b/ghc/lib/std/PrelCTypesISO.lhs index 0b9b3a4..6354864 100644 --- a/ghc/lib/std/PrelCTypesISO.lhs +++ b/ghc/lib/std/PrelCTypesISO.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $Id: PrelCTypesISO.lhs,v 1.3 2001/01/12 17:38:27 simonmar Exp $ +% $Id: PrelCTypesISO.lhs,v 1.4 2001/02/22 13:17:58 simonpj Exp $ % % (c) The FFI task force, 2000 % @@ -27,7 +27,6 @@ module PrelCTypesISO import PrelBase ( unsafeCoerce# ) import PrelReal ( Integral(toInt) ) import PrelBits ( Bits(..) ) -import PrelNum ( Num(fromInt) ) import PrelInt ( Int8, Int16, Int32, Int64 ) import PrelWord ( Word8, Word16, Word32, Word64 ) \end{code} diff --git a/ghc/lib/std/PrelFloat.lhs b/ghc/lib/std/PrelFloat.lhs index 3d202c7..51a01ab 100644 --- a/ghc/lib/std/PrelFloat.lhs +++ b/ghc/lib/std/PrelFloat.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: PrelFloat.lhs,v 1.9 2000/08/29 16:37:35 simonpj Exp $ +% $Id: PrelFloat.lhs,v 1.10 2001/02/22 13:17:58 simonpj Exp $ % % (c) The University of Glasgow, 1994-2000 % @@ -151,9 +151,6 @@ instance Num Float where -- fromInteger in turn inlines, -- so that if fromInteger is applied to an (S# i) the right thing happens - {-# INLINE fromInt #-} - fromInt i = int2Float i - instance Real Float where toRational x = (m%1)*(b%1)^^n where (m,n) = decodeFloat x @@ -293,8 +290,9 @@ instance Num Double where {-# INLINE fromInteger #-} -- See comments with Num Float - fromInteger n = encodeFloat n 0 - fromInt (I# n#) = case (int2Double# n#) of { d# -> D# d# } + fromInteger (S# i#) = case (int2Double# i#) of { d# -> D# d# } + fromInteger (J# s# d#) = encodeDouble# s# d# 0 + instance Real Double where toRational x = (m%1)*(b%1)^^n @@ -426,17 +424,17 @@ for these (@numericEnumFromTo@ and @numericEnumFromThenTo@ below.) instance Enum Float where succ x = x + 1 pred x = x - 1 - toEnum = fromInt - fromEnum = fromInteger . truncate -- may overflow - enumFrom = numericEnumFrom - enumFromTo = numericEnumFromTo - enumFromThen = numericEnumFromThen - enumFromThenTo = numericEnumFromThenTo + toEnum = int2Float + fromEnum = fromInteger . truncate -- may overflow + enumFrom = numericEnumFrom + enumFromTo = numericEnumFromTo + enumFromThen = numericEnumFromThen + enumFromThenTo = numericEnumFromThenTo instance Enum Double where succ x = x + 1 pred x = x - 1 - toEnum = fromInt + toEnum = int2Double fromEnum = fromInteger . truncate -- may overflow enumFrom = numericEnumFrom enumFromTo = numericEnumFromTo @@ -583,7 +581,7 @@ floatToDigits base x = (p - 1 + e0) * 3 `div` 10 else ceiling ((log (fromInteger (f+1)) + - fromInt e * log (fromInteger b)) / + fromInteger (int2Integer e) * log (fromInteger b)) / log (fromInteger base)) --WAS: fromInt e * log (fromInteger b)) diff --git a/ghc/lib/std/PrelHandle.lhs b/ghc/lib/std/PrelHandle.lhs index 33d208e..401870d 100644 --- a/ghc/lib/std/PrelHandle.lhs +++ b/ghc/lib/std/PrelHandle.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: PrelHandle.lhs,v 1.66 2001/01/11 17:25:57 simonmar Exp $ +% $Id: PrelHandle.lhs,v 1.67 2001/02/22 13:17:58 simonpj Exp $ % % (c) The AQUA Project, Glasgow University, 1994-2000 % @@ -26,7 +26,7 @@ import PrelIOBase import PrelMaybe ( Maybe(..) ) import PrelException import PrelEnum -import PrelNum ( toBig, Integer(..), Num(..) ) +import PrelNum ( toBig, Integer(..), Num(..), int2Integer ) import PrelShow import PrelReal ( toInteger ) import PrelPack ( packString ) @@ -610,7 +610,7 @@ hGetPosn handle = wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do posn <- getFilePosn (haFO__ handle_) -- ConcHask: SAFE, won't block if posn /= -1 then do - return (mkHandlePosn handle (fromInt posn)) + return (mkHandlePosn handle (int2Integer posn)) else constructErrorAndFail "hGetPosn" diff --git a/ghc/lib/std/PrelIOBase.lhs b/ghc/lib/std/PrelIOBase.lhs index 7bf96d1..a2b8fd0 100644 --- a/ghc/lib/std/PrelIOBase.lhs +++ b/ghc/lib/std/PrelIOBase.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: PrelIOBase.lhs,v 1.34 2001/02/20 18:40:54 qrczak Exp $ +% $Id: PrelIOBase.lhs,v 1.35 2001/02/22 13:17:58 simonpj Exp $ % % (c) The University of Glasgow, 1994-2000 % @@ -21,7 +21,7 @@ import {-# SOURCE #-} PrelErr ( error ) import PrelST import PrelBase -import PrelNum ( fromInt ) -- Integer literals +import PrelNum -- To get fromInteger etc, needed because of -fno-implicit-prelude import PrelMaybe ( Maybe(..) ) import PrelShow import PrelList @@ -119,8 +119,9 @@ returnIO x = IO (\ s -> (# s, x #)) #ifdef __HUGS__ /* Hugs doesn't distinguish these types so no coercion required) */ #else +-- stToIO :: (forall s. ST s a) -> IO a stToIO :: ST RealWorld a -> IO a -stToIO (ST m) = (IO m) +stToIO (ST m) = IO m ioToST :: IO a -> ST RealWorld a ioToST (IO m) = (ST m) @@ -139,8 +140,13 @@ ioToST (IO m) = (ST m) unsafePerformIO :: IO a -> a unsafePerformIO (IO m) = case m realWorld# of (# _, r #) -> r +{-# NOINLINE unsafeInterleaveIO #-} unsafeInterleaveIO :: IO a -> IO a -unsafeInterleaveIO = stToIO . unsafeInterleaveST . ioToST +unsafeInterleaveIO (IO m) + = IO ( \ s -> let + r = case m s of (# _, res #) -> res + in + (# s, r #)) #endif \end{code} diff --git a/ghc/lib/std/PrelInt.lhs b/ghc/lib/std/PrelInt.lhs index 28f2ca5..791a41c 100644 --- a/ghc/lib/std/PrelInt.lhs +++ b/ghc/lib/std/PrelInt.lhs @@ -208,7 +208,6 @@ instance Num Int8 where signum = signumReal fromInteger (S# i#) = I8# (intToInt8# i#) fromInteger (J# s# d#) = I8# (intToInt8# (integer2Int# s# d#)) - fromInt = intToInt8 instance Bounded Int8 where minBound = 0x80 @@ -353,7 +352,6 @@ instance Num Int16 where signum = signumReal fromInteger (S# i#) = I16# (intToInt16# i#) fromInteger (J# s# d#) = I16# (intToInt16# (integer2Int# s# d#)) - fromInt = intToInt16 instance Bounded Int16 where minBound = 0x8000 @@ -501,12 +499,14 @@ instance Num Int32 where signum = signumReal fromInteger (S# i#) = I32# (intToInt32# i#) fromInteger (J# s# d#) = I32# (intToInt32# (integer2Int# s# d#)) - fromInt = intToInt32 instance Bounded Int32 where - minBound = fromInt minBound - maxBound = fromInt maxBound + minBound = int2Int32 minBound + maxBound = int2Int32 maxBound + +int2Int32 :: Int -> Int32 +int2Int32 (I# i#) = I32# (intToInt32# i#) instance Real Int32 where toRational x = toInteger x % 1 @@ -637,7 +637,6 @@ instance Num Int64 where signum = signumReal fromInteger (S# i#) = I64# i# fromInteger (J# s# d#) = I64# (integer2Int# s# d#) - fromInt = intToInt64 instance Bounded Int64 where minBound = integerToInt64 (-0x8000000000000000) @@ -712,7 +711,6 @@ instance Num Int64 where abs x = absReal x signum = signumReal fromInteger i = integerToInt64 i - fromInt i = intToInt64 i compareInt64# :: Int64# -> Int64# -> Ordering compareInt64# i# j# diff --git a/ghc/lib/std/PrelNum.lhs b/ghc/lib/std/PrelNum.lhs index 31d5c7a..33233a0 100644 --- a/ghc/lib/std/PrelNum.lhs +++ b/ghc/lib/std/PrelNum.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: PrelNum.lhs,v 1.34 2000/09/26 16:45:34 simonpj Exp $ +% $Id: PrelNum.lhs,v 1.35 2001/02/22 13:17:59 simonpj Exp $ % % (c) The University of Glasgow, 1994-2000 % @@ -45,13 +45,13 @@ class (Eq a, Show a) => Num a where negate :: a -> a abs, signum :: a -> a fromInteger :: Integer -> a - fromInt :: Int -> a -- partain: Glasgow extension x - y = x + negate y negate x = 0 - x - fromInt (I# i#) = fromInteger (S# i#) - -- Go via the standard class-op if the - -- non-standard one ain't provided + +fromInt :: Num a => Int -> a +-- For backward compatibility +fromInt (I# i#) = fromInteger (S# i#) \end{code} A few small numeric functions @@ -85,7 +85,6 @@ instance Num Int where | otherwise = 1 fromInteger n = integer2Int n - fromInt n = n \end{code} @@ -320,7 +319,6 @@ instance Num Integer where (*) = timesInteger negate = negateInteger fromInteger x = x - fromInt (I# i) = S# i -- ORIG: abs n = if n >= 0 then n else -n abs (S# (-2147483648#)) = 2147483648 diff --git a/ghc/lib/std/PrelRead.lhs b/ghc/lib/std/PrelRead.lhs index a3bea26..084a22f 100644 --- a/ghc/lib/std/PrelRead.lhs +++ b/ghc/lib/std/PrelRead.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: PrelRead.lhs,v 1.16 2000/08/07 23:37:23 qrczak Exp $ +% $Id: PrelRead.lhs,v 1.17 2001/02/22 13:17:59 simonpj Exp $ % % (c) The University of Glasgow, 1994-2000 % @@ -539,7 +539,7 @@ readHex = readInt 16 isHexDigit hex readInt :: (Integral a) => a -> (Char -> Bool) -> (Char -> Int) -> ReadS a readInt radix isDig digToInt s = do (ds,r) <- nonnull isDig s - return (foldl1 (\n d -> n * radix + d) (map (fromInt . digToInt) ds), r) + return (foldl1 (\n d -> n * radix + d) (map (fromInteger . int2Integer . digToInt) ds), r) {-# SPECIALISE readSigned :: ReadS Int -> ReadS Int, diff --git a/ghc/lib/std/PrelReal.lhs b/ghc/lib/std/PrelReal.lhs index 1745d12..9f309a9 100644 --- a/ghc/lib/std/PrelReal.lhs +++ b/ghc/lib/std/PrelReal.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: PrelReal.lhs,v 1.7 2000/12/16 17:46:57 qrczak Exp $ +% $Id: PrelReal.lhs,v 1.8 2001/02/22 13:17:59 simonpj Exp $ % % (c) The University of Glasgow, 1994-2000 % @@ -254,7 +254,7 @@ instance (Integral a) => Enum (Ratio a) where succ x = x + 1 pred x = x - 1 - toEnum n = fromInt n :% 1 + toEnum n = fromInteger (int2Integer n) :% 1 fromEnum = fromInteger . truncate enumFrom = numericEnumFrom diff --git a/ghc/lib/std/PrelST.lhs b/ghc/lib/std/PrelST.lhs index 6c8ee76..7e43b89 100644 --- a/ghc/lib/std/PrelST.lhs +++ b/ghc/lib/std/PrelST.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: PrelST.lhs,v 1.18 2001/02/20 18:40:54 qrczak Exp $ +% $Id: PrelST.lhs,v 1.19 2001/02/22 13:17:59 simonpj Exp $ % % (c) The University of Glasgow, 1992-2000 % @@ -11,7 +11,7 @@ module PrelST where -import PrelNum ( fromInt ) -- For integer literals +import PrelNum -- To get fromInt etc, needed because of -fno-implicit-prelude import PrelShow import PrelBase import PrelNum () -- So that we get the .hi file for system imports diff --git a/ghc/lib/std/PrelWord.lhs b/ghc/lib/std/PrelWord.lhs index a09a0d1..e9110f4 100644 --- a/ghc/lib/std/PrelWord.lhs +++ b/ghc/lib/std/PrelWord.lhs @@ -249,7 +249,6 @@ instance Num Word8 where signum = signumReal fromInteger (S# i#) = W8# (wordToWord8# (int2Word# i#)) fromInteger (J# s# d#) = W8# (wordToWord8# (integer2Word# s# d#)) - fromInt = intToWord8 instance Bounded Word8 where minBound = 0 @@ -414,7 +413,6 @@ instance Num Word16 where signum = signumReal fromInteger (S# i#) = W16# (wordToWord16# (int2Word# i#)) fromInteger (J# s# d#) = W16# (wordToWord16# (integer2Word# s# d#)) - fromInt = intToWord16 instance Bounded Word16 where minBound = 0 @@ -558,7 +556,6 @@ instance Num Word32 where signum = signumReal fromInteger (S# i#) = W32# (intToWord32# i#) fromInteger (J# s# d#) = W32# (wordToWord32# (integer2Word# s# d#)) - fromInt (I# x) = W32# (intToWord32# x) -- ToDo: restrict fromInt{eger} range. intToWord32# :: Int# -> Word# @@ -775,7 +772,6 @@ instance Num Word64 where signum = signumReal fromInteger (S# i#) = W64# (int2Word# i#) fromInteger (J# s# d#) = W64# (integer2Word# s# d#) - fromInt = intToWord64 -- Note: no need to mask results here -- as they cannot overflow. @@ -860,7 +856,6 @@ instance Num Word64 where abs x = x signum = signumReal fromInteger i = integerToWord64 i - fromInt = intToWord64 -- Note: no need to mask results here as they cannot overflow. -- ToDo: protect against div by zero. diff --git a/ghc/lib/std/Prelude.lhs b/ghc/lib/std/Prelude.lhs index 0f9aa1a..1e86072 100644 --- a/ghc/lib/std/Prelude.lhs +++ b/ghc/lib/std/Prelude.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: Prelude.lhs,v 1.22 2000/06/30 13:39:36 simonmar Exp $ +% $Id: Prelude.lhs,v 1.23 2001/02/22 13:17:59 simonpj Exp $ % % (c) The University of Glasgow, 1992-2000 % @@ -52,7 +52,6 @@ module Prelude ( Enum(..), Bounded(..), Num((+), (-), (*), negate, abs, signum, fromInteger), - -- The fromInt method is exposed only by GlaExts Real(..), Integral(quot, rem, div, mod, quotRem, divMod, toInteger), -- The toInt method is exposed only by GlaExts diff --git a/ghc/lib/std/Random.lhs b/ghc/lib/std/Random.lhs index a5f1667..920d986 100644 --- a/ghc/lib/std/Random.lhs +++ b/ghc/lib/std/Random.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: Random.lhs,v 1.21 2000/06/30 13:39:36 simonmar Exp $ +% $Id: Random.lhs,v 1.22 2001/02/22 13:17:59 simonpj Exp $ % % (c) The University of Glasgow, 1995-2000 % @@ -33,7 +33,6 @@ module Random #ifndef __HUGS__ import PrelGHC ( RealWorld ) -import PrelNum ( fromInt ) import PrelShow ( showSignedInt, showSpace ) import PrelRead ( readDec ) import PrelIOBase ( unsafePerformIO, stToIO ) @@ -219,7 +218,7 @@ randomIvalInteger (l,h) rng let (x,g') = next g in - f (n-1) (fromInt x + acc * b) g' + f (n-1) (fromIntegral x + acc * b) g' randomIvalDouble :: (RandomGen g, Fractional a) => (Double, Double) -> (Double -> a) -> g -> (a, g) randomIvalDouble (l,h) fromDouble rng diff --git a/ghc/lib/std/cbits/CTypes.h b/ghc/lib/std/cbits/CTypes.h index 1d956b1..df156cf 100644 --- a/ghc/lib/std/cbits/CTypes.h +++ b/ghc/lib/std/cbits/CTypes.h @@ -1,5 +1,5 @@ /* ----------------------------------------------------------------------------- - * $Id: CTypes.h,v 1.2 2001/02/05 11:49:20 chak Exp $ + * $Id: CTypes.h,v 1.3 2001/02/22 13:17:59 simonpj Exp $ * * Dirty CPP hackery for CTypes/CTypesISO * @@ -230,8 +230,7 @@ instance Num T where { \ negate = unsafeCoerce# (negate :: B -> B); \ abs = unsafeCoerce# (abs :: B -> B); \ signum = unsafeCoerce# (signum :: B -> B); \ - fromInteger = unsafeCoerce# (fromInteger :: Integer -> B); \ - fromInt = unsafeCoerce# (fromInt :: Int -> B) } + fromInteger = unsafeCoerce# (fromInteger :: Integer -> B); } #define INSTANCE_BOUNDED(T,B) \ instance Bounded T where { \ -- 1.7.10.4