From: Don Stewart Date: Wed, 5 Mar 2008 01:58:27 +0000 (+0000) Subject: untabify X-Git-Tag: 2008-05-28~42 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=ad2f35188663652eca67184e744419478ac4b601;p=ghc-base.git untabify --- diff --git a/Control/Monad.hs b/Control/Monad.hs index 479a78c..c44ac82 100644 --- a/Control/Monad.hs +++ b/Control/Monad.hs @@ -20,9 +20,9 @@ module Control.Monad , Monad((>>=), (>>), return, fail) , MonadPlus ( -- class context: Monad - mzero -- :: (MonadPlus m) => m a - , mplus -- :: (MonadPlus m) => m a -> m a -> m a - ) + mzero -- :: (MonadPlus m) => m a + , mplus -- :: (MonadPlus m) => m a -> m a -> m a + ) -- * Functions -- ** Naming conventions @@ -88,15 +88,15 @@ infixr 1 =<< -- | Same as '>>=', but with the arguments interchanged. {-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-} (=<<) :: Monad m => (a -> m b) -> m a -> m b -f =<< x = x >>= f +f =<< x = x >>= f -- | Evaluate each action in the sequence from left to right, -- and collect the results. sequence :: Monad m => [m a] -> m [a] {-# INLINE sequence #-} sequence ms = foldr k (return []) ms - where - k m m' = do { x <- m; xs <- m'; return (x:xs) } + where + k m m' = do { x <- m; xs <- m'; return (x:xs) } -- | Evaluate each action in the sequence from left to right, -- and ignore the results. @@ -128,7 +128,7 @@ class Monad m => MonadPlus m where -- -- (but the instance for 'System.IO.IO' defined in Control.Monad.Error -- in the mtl package does not satisfy the second one). - mzero :: m a + mzero :: m a -- | an associative operation mplus :: m a -> m a -> m a @@ -219,15 +219,15 @@ the list arguments. This could be an issue where '(>>)' and the `folded function' are not commutative. -> foldM f a1 [x1, x2, ..., xm ] +> foldM f a1 [x1, x2, ..., xm ] == -> do -> a2 <- f a1 x1 -> a3 <- f a2 x2 -> ... -> f am xm +> do +> a2 <- f a1 x1 +> a3 <- f a2 x2 +> ... +> f am xm If right-to-left evaluation is required, the input list should be reversed. -} @@ -251,7 +251,7 @@ replicateM_ n x = sequence_ (replicate n x) {- | Conditional execution of monadic expressions. For example, -> when debug (putStr "Debugging\n") +> when debug (putStr "Debugging\n") will output the string @Debugging\\n@ if the Boolean value @debug@ is 'True', and otherwise do nothing. @@ -272,8 +272,8 @@ liftM f m1 = do { x1 <- m1; return (f x1) } -- | Promote a function to a monad, scanning the monadic arguments from -- left to right. For example, -- --- > liftM2 (+) [0,1] [0,2] = [0,2,1,3] --- > liftM2 (+) (Just 1) Nothing = Nothing +-- > liftM2 (+) [0,1] [0,2] = [0,2,1,3] +-- > liftM2 (+) (Just 1) Nothing = Nothing -- liftM2 :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r liftM2 f m1 m2 = do { x1 <- m1; x2 <- m2; return (f x1 x2) } @@ -296,11 +296,11 @@ liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; {- | In many situations, the 'liftM' operations can be replaced by uses of 'ap', which promotes function application. -> return f `ap` x1 `ap` ... `ap` xn +> return f `ap` x1 `ap` ... `ap` xn is equivalent to -> liftMn f x1 x2 ... xn +> liftMn f x1 x2 ... xn -} diff --git a/Data/Either.hs b/Data/Either.hs index 0c5e153..38766ad 100644 --- a/Data/Either.hs +++ b/Data/Either.hs @@ -15,7 +15,7 @@ module Data.Either ( Either(..), - either -- :: (a -> c) -> (b -> c) -> Either a b -> c + either -- :: (a -> c) -> (b -> c) -> Either a b -> c ) where #ifdef __GLASGOW_HASKELL__ @@ -31,7 +31,7 @@ either correct or an error; by convention, the 'Left' constructor is used to hold an error value and the 'Right' constructor is used to hold a correct value (mnemonic: \"right\" also means \"correct\"). -} -data Either a b = Left a | Right b deriving (Eq, Ord ) +data Either a b = Left a | Right b deriving (Eq, Ord ) -- | Case analysis for the 'Either' type. -- If the value is @'Left' a@, apply the first function to @a@; diff --git a/Data/Word.hs b/Data/Word.hs index 3f22423..bd34f72 100644 --- a/Data/Word.hs +++ b/Data/Word.hs @@ -14,16 +14,16 @@ ----------------------------------------------------------------------------- module Data.Word - ( - -- * Unsigned integral types + ( + -- * Unsigned integral types - Word, - Word8, Word16, Word32, Word64, - - -- * Notes - - -- $notes - ) where + Word, + Word8, Word16, Word32, Word64, + + -- * Notes + + -- $notes + ) where #ifdef __GLASGOW_HASKELL__ import GHC.Word @@ -35,7 +35,7 @@ import Hugs.Word #ifdef __NHC__ import NHC.FFI (Word8, Word16, Word32, Word64) -import NHC.SizedTypes (Word8, Word16, Word32, Word64) -- instances of Bits +import NHC.SizedTypes (Word8, Word16, Word32, Word64) -- instances of Bits type Word = Word32 #endif diff --git a/GHC/Arr.lhs b/GHC/Arr.lhs index a60e0b3..3b6d0ad 100644 --- a/GHC/Arr.lhs +++ b/GHC/Arr.lhs @@ -32,9 +32,9 @@ default () %********************************************************* -%* * +%* * \subsection{The @Ix@ class} -%* * +%* * %********************************************************* \begin{code} @@ -60,48 +60,48 @@ default () -- class (Ord a) => Ix a where -- | The list of values in the subrange defined by a bounding pair. - range :: (a,a) -> [a] + range :: (a,a) -> [a] -- | The position of a subscript in the subrange. - index :: (a,a) -> a -> Int + index :: (a,a) -> a -> Int -- | Like 'index', but without checking that the value is in range. - unsafeIndex :: (a,a) -> a -> Int + unsafeIndex :: (a,a) -> a -> Int -- | Returns 'True' the given subscript lies in the range defined -- the bounding pair. - inRange :: (a,a) -> a -> Bool + inRange :: (a,a) -> a -> Bool -- | The size of the subrange defined by a bounding pair. - rangeSize :: (a,a) -> Int + rangeSize :: (a,a) -> Int -- | like 'rangeSize', but without checking that the upper bound is -- in range. unsafeRangeSize :: (a,a) -> Int - -- Must specify one of index, unsafeIndex - index b i | inRange b i = unsafeIndex b i - | otherwise = error "Error in array index" + -- Must specify one of index, unsafeIndex + index b i | inRange b i = unsafeIndex b i + | otherwise = error "Error in array index" unsafeIndex b i = index b i rangeSize b@(_l,h) | inRange b h = unsafeIndex b h + 1 - | otherwise = 0 -- This case is only here to - -- check for an empty range - -- NB: replacing (inRange b h) by (l <= h) fails for - -- tuples. E.g. (1,2) <= (2,1) but the range is empty + | otherwise = 0 -- This case is only here to + -- check for an empty range + -- NB: replacing (inRange b h) by (l <= h) fails for + -- tuples. E.g. (1,2) <= (2,1) but the range is empty unsafeRangeSize b@(_l,h) = unsafeIndex b h + 1 \end{code} Note that the following is NOT right - rangeSize (l,h) | l <= h = index b h + 1 - | otherwise = 0 + rangeSize (l,h) | l <= h = index b h + 1 + | otherwise = 0 Because it might be the case that l (a,a) -> a -> String -> b indexError rng i tp = error (showString "Ix{" . showString tp . showString "}.index: Index " . showParen True (showsPrec 0 i) . - showString " out of range " $ - showParen True (showsPrec 0 rng) "") + showString " out of range " $ + showParen True (showsPrec 0 rng) "") ---------------------------------------------------------------------- instance Ix Char where @@ -125,22 +125,22 @@ instance Ix Char where unsafeIndex (m,_n) i = fromEnum i - fromEnum m index b i | inRange b i = unsafeIndex b i - | otherwise = indexError b i "Char" + | otherwise = indexError b i "Char" - inRange (m,n) i = m <= i && i <= n + inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- instance Ix Int where {-# INLINE range #-} - -- The INLINE stops the build in the RHS from getting inlined, - -- so that callers can fuse with the result of range + -- The INLINE stops the build in the RHS from getting inlined, + -- so that callers can fuse with the result of range range (m,n) = [m..n] {-# INLINE unsafeIndex #-} unsafeIndex (m,_n) i = i - m index b i | inRange b i = unsafeIndex b i - | otherwise = indexError b i "Int" + | otherwise = indexError b i "Int" {-# INLINE inRange #-} inRange (I# m,I# n) (I# i) = m <=# i && i <=# n @@ -154,9 +154,9 @@ instance Ix Integer where unsafeIndex (m,_n) i = fromInteger (i - m) index b i | inRange b i = unsafeIndex b i - | otherwise = indexError b i "Integer" + | otherwise = indexError b i "Integer" - inRange (m,n) i = m <= i && i <= n + inRange (m,n) i = m <= i && i <= n ---------------------------------------------------------------------- instance Ix Bool where -- as derived @@ -167,7 +167,7 @@ instance Ix Bool where -- as derived unsafeIndex (l,_) i = fromEnum i - fromEnum l index b i | inRange b i = unsafeIndex b i - | otherwise = indexError b i "Bool" + | otherwise = indexError b i "Bool" inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u @@ -180,7 +180,7 @@ instance Ix Ordering where -- as derived unsafeIndex (l,_) i = fromEnum i - fromEnum l index b i | inRange b i = unsafeIndex b i - | otherwise = indexError b i "Ordering" + | otherwise = indexError b i "Ordering" inRange (l,u) i = fromEnum i >= fromEnum l && fromEnum i <= fromEnum u @@ -277,9 +277,9 @@ instance (Ix a1, Ix a2, Ix a3, Ix a4, Ix a5) => Ix (a1,a2,a3,a4,a5) where \end{code} %********************************************************* -%* * +%* * \subsection{The @Array@ types} -%* * +%* * %********************************************************* \begin{code} @@ -312,8 +312,8 @@ data STArray s i e -- used to make sure an index is -- really in range (MutableArray# s e) -- The actual elements - -- No Ix context for STArray. They are stupid, - -- and force an Ix context on the equality instance. + -- No Ix context for STArray. They are stupid, + -- and force an Ix context on the equality instance. -- Just pointer equality on mutable arrays: instance Eq (STArray s i e) where @@ -323,9 +323,9 @@ instance Eq (STArray s i e) where %********************************************************* -%* * +%* * \subsection{Operations on immutable arrays} -%* * +%* * %********************************************************* \begin{code} @@ -360,18 +360,18 @@ arrEleBottom = error "(Array.!): undefined array element" -- with which the array was constructed. {-# INLINE array #-} array :: Ix i - => (i,i) -- ^ a pair of /bounds/, each of the index type - -- of the array. These bounds are the lowest and - -- highest indices in the array, in that order. - -- For example, a one-origin vector of length - -- '10' has bounds '(1,10)', and a one-origin '10' - -- by '10' matrix has bounds '((1,1),(10,10))'. - -> [(i, e)] -- ^ a list of /associations/ of the form - -- (/index/, /value/). Typically, this list will - -- be expressed as a comprehension. An - -- association '(i, x)' defines the value of - -- the array at index 'i' to be 'x'. - -> Array i e + => (i,i) -- ^ a pair of /bounds/, each of the index type + -- of the array. These bounds are the lowest and + -- highest indices in the array, in that order. + -- For example, a one-origin vector of length + -- '10' has bounds '(1,10)', and a one-origin '10' + -- by '10' matrix has bounds '((1,1),(10,10))'. + -> [(i, e)] -- ^ a list of /associations/ of the form + -- (/index/, /value/). Typically, this list will + -- be expressed as a comprehension. An + -- association '(i, x)' defines the value of + -- the array at index 'i' to be 'x'. + -> Array i e array (l,u) ies = let n = safeRangeSize (l,u) in unsafeArray' (l,u) n @@ -487,11 +487,11 @@ assocs arr@(Array l u _ _) = -- not in general be recursive. {-# INLINE accumArray #-} accumArray :: Ix i - => (e -> a -> e) -- ^ accumulating function - -> e -- ^ initial value - -> (i,i) -- ^ bounds of the array - -> [(i, a)] -- ^ association list - -> Array i e + => (e -> a -> e) -- ^ accumulating function + -> e -- ^ initial value + -> (i,i) -- ^ bounds of the array + -> [(i, a)] -- ^ association list + -> Array i e accumArray f init (l,u) ies = let n = safeRangeSize (l,u) in unsafeAccumArray' f init (l,u) n @@ -600,9 +600,9 @@ cmpIntArray arr1@(Array l1 u1 n1 _) arr2@(Array l2 u2 n2 _) = %********************************************************* -%* * +%* * \subsection{Array instances} -%* * +%* * %********************************************************* \begin{code} @@ -622,16 +622,16 @@ instance (Ix a, Show a, Show b) => Show (Array a b) where showsPrec appPrec1 (bounds a) . showChar ' ' . showsPrec appPrec1 (assocs a) - -- Precedence of 'array' is the precedence of application + -- Precedence of 'array' is the precedence of application -- The Read instance is in GHC.Read \end{code} %********************************************************* -%* * +%* * \subsection{Operations on mutable arrays} -%* * +%* * %********************************************************* Idle ADR question: What's the tradeoff here between flattening these @@ -687,9 +687,9 @@ unsafeWriteSTArray (STArray _ _ _ marr#) (I# i#) e = ST $ \s1# -> %********************************************************* -%* * +%* * \subsection{Moving between mutable and immutable} -%* * +%* * %********************************************************* \begin{code} diff --git a/GHC/Float.lhs b/GHC/Float.lhs index ff40906..6808d63 100644 --- a/GHC/Float.lhs +++ b/GHC/Float.lhs @@ -34,9 +34,9 @@ infixr 8 ** \end{code} %********************************************************* -%* * +%* * \subsection{Standard numeric classes} -%* * +%* * %********************************************************* \begin{code} @@ -46,35 +46,35 @@ infixr 8 ** -- 'pi', 'exp', 'log', 'sin', 'cos', 'sinh', 'cosh', -- 'asin', 'acos', 'atan', 'asinh', 'acosh' and 'atanh' class (Fractional a) => Floating a where - pi :: a - exp, log, sqrt :: a -> a - (**), logBase :: a -> a -> a - sin, cos, tan :: a -> a - asin, acos, atan :: a -> a - sinh, cosh, tanh :: a -> a + pi :: a + exp, log, sqrt :: a -> a + (**), logBase :: a -> a -> a + sin, cos, tan :: a -> a + asin, acos, atan :: a -> a + sinh, cosh, tanh :: a -> a asinh, acosh, atanh :: a -> a - x ** y = exp (log x * y) - logBase x y = log y / log x - sqrt x = x ** 0.5 - tan x = sin x / cos x - tanh x = sinh x / cosh x + x ** y = exp (log x * y) + logBase x y = log y / log x + sqrt x = x ** 0.5 + tan x = sin x / cos x + tanh x = sinh x / cosh x -- | Efficient, machine-independent access to the components of a -- floating-point number. -- -- Minimal complete definition: --- all except 'exponent', 'significand', 'scaleFloat' and 'atan2' +-- all except 'exponent', 'significand', 'scaleFloat' and 'atan2' class (RealFrac a, Floating a) => RealFloat a where -- | a constant function, returning the radix of the representation -- (often @2@) - floatRadix :: a -> Integer + floatRadix :: a -> Integer -- | a constant function, returning the number of digits of -- 'floatRadix' in the significand - floatDigits :: a -> Int + floatDigits :: a -> Int -- | a constant function, returning the lowest and highest values -- the exponent may assume - floatRange :: a -> (Int,Int) + floatRange :: a -> (Int,Int) -- | The function 'decodeFloat' applied to a real floating-point -- number returns the significand expressed as an 'Integer' and an -- appropriately scaled exponent (an 'Int'). If @'decodeFloat' x@ @@ -82,27 +82,27 @@ class (RealFrac a, Floating a) => RealFloat a where -- is the floating-point radix, and furthermore, either @m@ and @n@ -- are both zero or else @b^(d-1) <= m < b^d@, where @d@ is the value -- of @'floatDigits' x@. In particular, @'decodeFloat' 0 = (0,0)@. - decodeFloat :: a -> (Integer,Int) + decodeFloat :: a -> (Integer,Int) -- | 'encodeFloat' performs the inverse of 'decodeFloat' - encodeFloat :: Integer -> Int -> a + encodeFloat :: Integer -> Int -> a -- | the second component of 'decodeFloat'. - exponent :: a -> Int + exponent :: a -> Int -- | the first component of 'decodeFloat', scaled to lie in the open -- interval (@-1@,@1@) - significand :: a -> a + significand :: a -> a -- | multiplies a floating-point number by an integer power of the radix - scaleFloat :: Int -> a -> a + scaleFloat :: Int -> a -> a -- | 'True' if the argument is an IEEE \"not-a-number\" (NaN) value - isNaN :: a -> Bool + isNaN :: a -> Bool -- | 'True' if the argument is an IEEE infinity or negative infinity - isInfinite :: a -> Bool + isInfinite :: a -> Bool -- | 'True' if the argument is too small to be represented in -- normalized format - isDenormalized :: a -> Bool + isDenormalized :: a -> Bool -- | 'True' if the argument is an IEEE negative zero - isNegativeZero :: a -> Bool + isNegativeZero :: a -> Bool -- | 'True' if the argument is an IEEE floating point number - isIEEE :: a -> Bool + isIEEE :: a -> Bool -- | a version of arctangent taking two real floating-point arguments. -- For real floating @x@ and @y@, @'atan2' y x@ computes the angle -- (from the positive x-axis) of the vector from the origin to the @@ -112,18 +112,18 @@ class (RealFrac a, Floating a) => RealFloat a where -- that is 'RealFloat', should return the same value as @'atan' y@. -- A default definition of 'atan2' is provided, but implementors -- can provide a more accurate implementation. - atan2 :: a -> a -> a + atan2 :: a -> a -> a - exponent x = if m == 0 then 0 else n + floatDigits x - where (m,n) = decodeFloat x + exponent x = if m == 0 then 0 else n + floatDigits x + where (m,n) = decodeFloat x - significand x = encodeFloat m (negate (floatDigits x)) - where (m,_) = decodeFloat x + significand x = encodeFloat m (negate (floatDigits x)) + where (m,_) = decodeFloat x - scaleFloat k x = encodeFloat m (n+k) - where (m,n) = decodeFloat x - + scaleFloat k x = encodeFloat m (n+k) + where (m,n) = decodeFloat x + atan2 y x | x > 0 = atan (y/x) | x == 0 && y > 0 = pi/2 @@ -140,28 +140,28 @@ class (RealFrac a, Floating a) => RealFloat a where %********************************************************* -%* * +%* * \subsection{Type @Integer@, @Float@, @Double@} -%* * +%* * %********************************************************* \begin{code} -- | Single-precision floating point numbers. -- It is desirable that this type be at least equal in range and precision -- to the IEEE single-precision type. -data Float = F# Float# +data Float = F# Float# -- | Double-precision floating point numbers. -- It is desirable that this type be at least equal in range and precision -- to the IEEE double-precision type. -data Double = D# Double# +data Double = D# Double# \end{code} %********************************************************* -%* * +%* * \subsection{Type @Float@} -%* * +%* * %********************************************************* \begin{code} @@ -170,8 +170,8 @@ instance Eq Float where instance Ord Float where (F# x) `compare` (F# y) | x `ltFloat#` y = LT - | x `eqFloat#` y = EQ - | otherwise = GT + | x `eqFloat#` y = EQ + | otherwise = GT (F# x) < (F# y) = x `ltFloat#` y (F# x) <= (F# y) = x `leFloat#` y @@ -179,34 +179,34 @@ instance Ord Float where (F# x) > (F# y) = x `gtFloat#` y instance Num Float where - (+) x y = plusFloat x y - (-) x y = minusFloat x y - negate x = negateFloat x - (*) x y = timesFloat x y - abs x | x >= 0.0 = x - | otherwise = negateFloat x - signum x | x == 0.0 = 0 - | x > 0.0 = 1 - | otherwise = negate 1 + (+) x y = plusFloat x y + (-) x y = minusFloat x y + negate x = negateFloat x + (*) x y = timesFloat x y + abs x | x >= 0.0 = x + | otherwise = negateFloat x + signum x | x == 0.0 = 0 + | x > 0.0 = 1 + | otherwise = negate 1 {-# INLINE fromInteger #-} fromInteger (S# i#) = case (int2Float# i#) of { d# -> F# d# } fromInteger (J# s# d#) = encodeFloat# s# d# 0 - -- previous code: fromInteger n = encodeFloat n 0 - -- doesn't work too well, because encodeFloat is defined in - -- terms of ccalls which can never be simplified away. We - -- want simple literals like (fromInteger 3 :: Float) to turn - -- into (F# 3.0), hence the special case for S# here. + -- previous code: fromInteger n = encodeFloat n 0 + -- doesn't work too well, because encodeFloat is defined in + -- terms of ccalls which can never be simplified away. We + -- want simple literals like (fromInteger 3 :: Float) to turn + -- into (F# 3.0), hence the special case for S# here. instance Real Float where - toRational x = (m%1)*(b%1)^^n - where (m,n) = decodeFloat x - b = floatRadix x + toRational x = (m%1)*(b%1)^^n + where (m,n) = decodeFloat x + b = floatRadix x instance Fractional Float where - (/) x y = divideFloat x y - fromRational x = fromRat x - recip x = 1.0 / x + (/) x y = divideFloat x y + fromRational x = fromRat x + recip x = 1.0 / x {-# RULES "truncate/Float->Int" truncate = float2Int #-} instance RealFrac Float where @@ -217,82 +217,82 @@ instance RealFrac Float where {-# SPECIALIZE properFraction :: Float -> (Integer, Float) #-} {-# SPECIALIZE round :: Float -> Integer #-} - -- ceiling, floor, and truncate are all small + -- ceiling, floor, and truncate are all small {-# INLINE ceiling #-} {-# INLINE floor #-} {-# INLINE truncate #-} properFraction x = case (decodeFloat x) of { (m,n) -> - let b = floatRadix x in - if n >= 0 then - (fromInteger m * fromInteger b ^ n, 0.0) - else - case (quotRem m (b^(negate n))) of { (w,r) -> - (fromInteger w, encodeFloat r n) - } + let b = floatRadix x in + if n >= 0 then + (fromInteger m * fromInteger b ^ n, 0.0) + else + case (quotRem m (b^(negate n))) of { (w,r) -> + (fromInteger w, encodeFloat r n) + } } - truncate x = case properFraction x of - (n,_) -> n + truncate x = case properFraction x of + (n,_) -> n - round x = case properFraction x of - (n,r) -> let - m = if r < 0.0 then n - 1 else n + 1 - half_down = abs r - 0.5 - in - case (compare half_down 0.0) of - LT -> n - EQ -> if even n then n else m - GT -> m + round x = case properFraction x of + (n,r) -> let + m = if r < 0.0 then n - 1 else n + 1 + half_down = abs r - 0.5 + in + case (compare half_down 0.0) of + LT -> n + EQ -> if even n then n else m + GT -> m ceiling x = case properFraction x of - (n,r) -> if r > 0.0 then n + 1 else n + (n,r) -> if r > 0.0 then n + 1 else n - floor x = case properFraction x of - (n,r) -> if r < 0.0 then n - 1 else n + floor x = case properFraction x of + (n,r) -> if r < 0.0 then n - 1 else n instance Floating Float where - pi = 3.141592653589793238 - exp x = expFloat x - log x = logFloat x - sqrt x = sqrtFloat x - sin x = sinFloat x - cos x = cosFloat x - tan x = tanFloat x - asin x = asinFloat x - acos x = acosFloat x - atan x = atanFloat x - sinh x = sinhFloat x - cosh x = coshFloat x - tanh x = tanhFloat x - (**) x y = powerFloat x y - logBase x y = log y / log x + pi = 3.141592653589793238 + exp x = expFloat x + log x = logFloat x + sqrt x = sqrtFloat x + sin x = sinFloat x + cos x = cosFloat x + tan x = tanFloat x + asin x = asinFloat x + acos x = acosFloat x + atan x = atanFloat x + sinh x = sinhFloat x + cosh x = coshFloat x + tanh x = tanhFloat x + (**) x y = powerFloat x y + logBase x y = log y / log x asinh x = log (x + sqrt (1.0+x*x)) acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0))) atanh x = log ((x+1.0) / sqrt (1.0-x*x)) instance RealFloat Float where - floatRadix _ = FLT_RADIX -- from float.h - floatDigits _ = FLT_MANT_DIG -- ditto - floatRange _ = (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto + floatRadix _ = FLT_RADIX -- from float.h + floatDigits _ = FLT_MANT_DIG -- ditto + floatRange _ = (FLT_MIN_EXP, FLT_MAX_EXP) -- ditto decodeFloat (F# f#) - = case decodeFloat# f# of - (# exp#, s#, d# #) -> (J# s# d#, I# exp#) + = case decodeFloat# f# of + (# exp#, s#, d# #) -> (J# s# d#, I# exp#) encodeFloat (S# i) j = int_encodeFloat# i j encodeFloat (J# s# d#) e = encodeFloat# s# d# e - exponent x = case decodeFloat x of - (m,n) -> if m == 0 then 0 else n + floatDigits x + exponent x = case decodeFloat x of + (m,n) -> if m == 0 then 0 else n + floatDigits x - significand x = case decodeFloat x of - (m,_) -> encodeFloat m (negate (floatDigits x)) + significand x = case decodeFloat x of + (m,_) -> encodeFloat m (negate (floatDigits x)) - scaleFloat k x = case decodeFloat x of - (m,n) -> encodeFloat m (n+k) + scaleFloat k x = case decodeFloat x of + (m,n) -> encodeFloat m (n+k) isNaN x = 0 /= isFloatNaN x isInfinite x = 0 /= isFloatInfinite x isDenormalized x = 0 /= isFloatDenormalized x @@ -305,9 +305,9 @@ instance Show Float where \end{code} %********************************************************* -%* * +%* * \subsection{Type @Double@} -%* * +%* * %********************************************************* \begin{code} @@ -316,8 +316,8 @@ instance Eq Double where instance Ord Double where (D# x) `compare` (D# y) | x <## y = LT - | x ==## y = EQ - | otherwise = GT + | x ==## y = EQ + | otherwise = GT (D# x) < (D# y) = x <## y (D# x) <= (D# y) = x <=## y @@ -325,48 +325,48 @@ instance Ord Double where (D# x) > (D# y) = x >## y instance Num Double where - (+) x y = plusDouble x y - (-) x y = minusDouble x y - negate x = negateDouble x - (*) x y = timesDouble x y - abs x | x >= 0.0 = x - | otherwise = negateDouble x - signum x | x == 0.0 = 0 - | x > 0.0 = 1 - | otherwise = negate 1 + (+) x y = plusDouble x y + (-) x y = minusDouble x y + negate x = negateDouble x + (*) x y = timesDouble x y + abs x | x >= 0.0 = x + | otherwise = negateDouble x + signum x | x == 0.0 = 0 + | x > 0.0 = 1 + | otherwise = negate 1 {-# INLINE fromInteger #-} - -- See comments with Num Float + -- See comments with Num Float 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 - where (m,n) = decodeFloat x - b = floatRadix x + toRational x = (m%1)*(b%1)^^n + where (m,n) = decodeFloat x + b = floatRadix x instance Fractional Double where - (/) x y = divideDouble x y - fromRational x = fromRat x - recip x = 1.0 / x + (/) x y = divideDouble x y + fromRational x = fromRat x + recip x = 1.0 / x instance Floating Double where - pi = 3.141592653589793238 - exp x = expDouble x - log x = logDouble x - sqrt x = sqrtDouble x - sin x = sinDouble x - cos x = cosDouble x - tan x = tanDouble x - asin x = asinDouble x - acos x = acosDouble x - atan x = atanDouble x - sinh x = sinhDouble x - cosh x = coshDouble x - tanh x = tanhDouble x - (**) x y = powerDouble x y - logBase x y = log y / log x + pi = 3.141592653589793238 + exp x = expDouble x + log x = logDouble x + sqrt x = sqrtDouble x + sin x = sinDouble x + cos x = cosDouble x + tan x = tanDouble x + asin x = asinDouble x + acos x = acosDouble x + atan x = atanDouble x + sinh x = sinhDouble x + cosh x = coshDouble x + tanh x = tanhDouble x + (**) x y = powerDouble x y + logBase x y = log y / log x asinh x = log (x + sqrt (1.0+x*x)) acosh x = log (x + (x+1.0) * sqrt ((x-1.0)/(x+1.0))) @@ -381,67 +381,67 @@ instance RealFrac Double where {-# SPECIALIZE properFraction :: Double -> (Integer, Double) #-} {-# SPECIALIZE round :: Double -> Integer #-} - -- ceiling, floor, and truncate are all small + -- ceiling, floor, and truncate are all small {-# INLINE ceiling #-} {-# INLINE floor #-} {-# INLINE truncate #-} properFraction x = case (decodeFloat x) of { (m,n) -> - let b = floatRadix x in - if n >= 0 then - (fromInteger m * fromInteger b ^ n, 0.0) - else - case (quotRem m (b^(negate n))) of { (w,r) -> - (fromInteger w, encodeFloat r n) - } + let b = floatRadix x in + if n >= 0 then + (fromInteger m * fromInteger b ^ n, 0.0) + else + case (quotRem m (b^(negate n))) of { (w,r) -> + (fromInteger w, encodeFloat r n) + } } - truncate x = case properFraction x of - (n,_) -> n + truncate x = case properFraction x of + (n,_) -> n - round x = case properFraction x of - (n,r) -> let - m = if r < 0.0 then n - 1 else n + 1 - half_down = abs r - 0.5 - in - case (compare half_down 0.0) of - LT -> n - EQ -> if even n then n else m - GT -> m + round x = case properFraction x of + (n,r) -> let + m = if r < 0.0 then n - 1 else n + 1 + half_down = abs r - 0.5 + in + case (compare half_down 0.0) of + LT -> n + EQ -> if even n then n else m + GT -> m ceiling x = case properFraction x of - (n,r) -> if r > 0.0 then n + 1 else n + (n,r) -> if r > 0.0 then n + 1 else n - floor x = case properFraction x of - (n,r) -> if r < 0.0 then n - 1 else n + floor x = case properFraction x of + (n,r) -> if r < 0.0 then n - 1 else n instance RealFloat Double where - floatRadix _ = FLT_RADIX -- from float.h - floatDigits _ = DBL_MANT_DIG -- ditto - floatRange _ = (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto + floatRadix _ = FLT_RADIX -- from float.h + floatDigits _ = DBL_MANT_DIG -- ditto + floatRange _ = (DBL_MIN_EXP, DBL_MAX_EXP) -- ditto decodeFloat (D# x#) - = case decodeDouble# x# of - (# exp#, s#, d# #) -> (J# s# d#, I# exp#) + = case decodeDouble# x# of + (# exp#, s#, d# #) -> (J# s# d#, I# exp#) encodeFloat (S# i) j = int_encodeDouble# i j encodeFloat (J# s# d#) e = encodeDouble# s# d# e - exponent x = case decodeFloat x of - (m,n) -> if m == 0 then 0 else n + floatDigits x + exponent x = case decodeFloat x of + (m,n) -> if m == 0 then 0 else n + floatDigits x - significand x = case decodeFloat x of - (m,_) -> encodeFloat m (negate (floatDigits x)) + significand x = case decodeFloat x of + (m,_) -> encodeFloat m (negate (floatDigits x)) - scaleFloat k x = case decodeFloat x of - (m,n) -> encodeFloat m (n+k) + scaleFloat k x = case decodeFloat x of + (m,n) -> encodeFloat m (n+k) - isNaN x = 0 /= isDoubleNaN x - isInfinite x = 0 /= isDoubleInfinite x - isDenormalized x = 0 /= isDoubleDenormalized x - isNegativeZero x = 0 /= isDoubleNegativeZero x - isIEEE _ = True + isNaN x = 0 /= isDoubleNaN x + isInfinite x = 0 /= isDoubleInfinite x + isDenormalized x = 0 /= isDoubleDenormalized x + isNegativeZero x = 0 /= isDoubleNegativeZero x + isIEEE _ = True instance Show Double where showsPrec x = showSigned showFloat x @@ -449,9 +449,9 @@ instance Show Double where \end{code} %********************************************************* -%* * +%* * \subsection{@Enum@ instances} -%* * +%* * %********************************************************* The @Enum@ instances for Floats and Doubles are slightly unusual. @@ -469,21 +469,21 @@ for these (@numericEnumFromTo@ and @numericEnumFromThenTo@ below.) \begin{code} instance Enum Float where - succ x = x + 1 - pred x = x - 1 + succ x = x + 1 + pred x = x - 1 toEnum = int2Float fromEnum = fromInteger . truncate -- may overflow - enumFrom = numericEnumFrom + enumFrom = numericEnumFrom enumFromTo = numericEnumFromTo enumFromThen = numericEnumFromThen enumFromThenTo = numericEnumFromThenTo instance Enum Double where - succ x = x + 1 - pred x = x - 1 + succ x = x + 1 + pred x = x - 1 toEnum = int2Double fromEnum = fromInteger . truncate -- may overflow - enumFrom = numericEnumFrom + enumFrom = numericEnumFrom enumFromTo = numericEnumFromTo enumFromThen = numericEnumFromThen enumFromThenTo = numericEnumFromThenTo @@ -491,9 +491,9 @@ instance Enum Double where %********************************************************* -%* * +%* * \subsection{Printing floating point} -%* * +%* * %********************************************************* @@ -510,10 +510,10 @@ data FFFormat = FFExponent | FFFixed | FFGeneric formatRealFloat :: (RealFloat a) => FFFormat -> Maybe Int -> a -> String formatRealFloat fmt decs x - | isNaN x = "NaN" + | isNaN x = "NaN" | isInfinite x = if x < 0 then "-Infinity" else "Infinity" | x < 0 || isNegativeZero x = '-':doFmt fmt (floatToDigits (toInteger base) (-x)) - | otherwise = doFmt fmt (floatToDigits (toInteger base) x) + | otherwise = doFmt fmt (floatToDigits (toInteger base) x) where base = 10 @@ -522,53 +522,53 @@ formatRealFloat fmt decs x case format of FFGeneric -> doFmt (if e < 0 || e > 7 then FFExponent else FFFixed) - (is,e) + (is,e) FFExponent -> case decs of Nothing -> let show_e' = show (e-1) in - case ds of + case ds of "0" -> "0.0e0" [d] -> d : ".0e" ++ show_e' - (d:ds') -> d : '.' : ds' ++ "e" ++ show_e' + (d:ds') -> d : '.' : ds' ++ "e" ++ show_e' Just dec -> let dec' = max dec 1 in case is of [0] -> '0' :'.' : take dec' (repeat '0') ++ "e0" _ -> let - (ei,is') = roundTo base (dec'+1) is - (d:ds') = map intToDigit (if ei > 0 then init is' else is') + (ei,is') = roundTo base (dec'+1) is + (d:ds') = map intToDigit (if ei > 0 then init is' else is') in - d:'.':ds' ++ 'e':show (e-1+ei) + d:'.':ds' ++ 'e':show (e-1+ei) FFFixed -> let mk0 ls = case ls of { "" -> "0" ; _ -> ls} in case decs of Nothing - | e <= 0 -> "0." ++ replicate (-e) '0' ++ ds - | otherwise -> - let - f 0 s rs = mk0 (reverse s) ++ '.':mk0 rs - f n s "" = f (n-1) ('0':s) "" - f n s (r:rs) = f (n-1) (r:s) rs - in - f e "" ds + | e <= 0 -> "0." ++ replicate (-e) '0' ++ ds + | otherwise -> + let + f 0 s rs = mk0 (reverse s) ++ '.':mk0 rs + f n s "" = f (n-1) ('0':s) "" + f n s (r:rs) = f (n-1) (r:s) rs + in + f e "" ds Just dec -> let dec' = max dec 0 in - if e >= 0 then - let - (ei,is') = roundTo base (dec' + e) is - (ls,rs) = splitAt (e+ei) (map intToDigit is') - in - mk0 ls ++ (if null rs then "" else '.':rs) - else - let - (ei,is') = roundTo base dec' (replicate (-e) 0 ++ is) - d:ds' = map intToDigit (if ei > 0 then is' else 0:is') - in - d : (if null ds' then "" else '.':ds') + if e >= 0 then + let + (ei,is') = roundTo base (dec' + e) is + (ls,rs) = splitAt (e+ei) (map intToDigit is') + in + mk0 ls ++ (if null rs then "" else '.':rs) + else + let + (ei,is') = roundTo base dec' (replicate (-e) 0 ++ is) + d:ds' = map intToDigit (if ei > 0 then is' else 0:is') + in + d : (if null ds' then "" else '.':ds') roundTo :: Int -> Int -> [Int] -> (Int,[Int]) @@ -600,11 +600,11 @@ roundTo base d is = -- -- then -- --- (1) @n >= 1@ +-- (1) @n >= 1@ -- --- (2) @x = 0.d1d2...dn * (base**e)@ +-- (2) @x = 0.d1d2...dn * (base**e)@ -- --- (3) @0 <= di <= base-1@ +-- (3) @0 <= di <= base-1@ floatToDigits :: (RealFloat a) => Integer -> a -> ([Int], Int) floatToDigits _ 0 = ([0], 0) @@ -639,15 +639,15 @@ floatToDigits base x = k0 = if b == 2 && base == 10 then -- logBase 10 2 is slightly bigger than 3/10 so - -- the following will err on the low side. Ignoring - -- the fraction will make it err even more. - -- Haskell promises that p-1 <= logBase b f < p. - (p - 1 + e0) * 3 `div` 10 + -- the following will err on the low side. Ignoring + -- the fraction will make it err even more. + -- Haskell promises that p-1 <= logBase b f < p. + (p - 1 + e0) * 3 `div` 10 else ceiling ((log (fromInteger (f+1)) + - fromInteger (int2Integer e) * log (fromInteger b)) / - log (fromInteger base)) ---WAS: fromInt e * log (fromInteger b)) + fromInteger (int2Integer e) * log (fromInteger b)) / + log (fromInteger base)) +--WAS: fromInt e * log (fromInteger b)) fixup n = if n >= 0 then @@ -682,9 +682,9 @@ floatToDigits base x = %********************************************************* -%* * +%* * \subsection{Converting from a Rational to a RealFloat -%* * +%* * %********************************************************* [In response to a request for documentation of how fromRational works, @@ -701,37 +701,37 @@ Unfortunately, Joe's code doesn't work! Here's an example: main = putStr (shows (1.82173691287639817263897126389712638972163e-300::Double) "\n") This program prints - 0.0000000000000000 + 0.0000000000000000 instead of - 1.8217369128763981e-300 + 1.8217369128763981e-300 Here's Joe's code: \begin{pseudocode} fromRat :: (RealFloat a) => Rational -> a fromRat x = x' - where x' = f e - --- If the exponent of the nearest floating-point number to x --- is e, then the significand is the integer nearest xb^(-e), --- where b is the floating-point radix. We start with a good --- guess for e, and if it is correct, the exponent of the --- floating-point number we construct will again be e. If --- not, one more iteration is needed. - - f e = if e' == e then y else f e' - where y = encodeFloat (round (x * (1 % b)^^e)) e - (_,e') = decodeFloat y - b = floatRadix x' - --- We obtain a trial exponent by doing a floating-point --- division of x's numerator by its denominator. The --- result of this division may not itself be the ultimate --- result, because of an accumulation of three rounding --- errors. - - (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x' - / fromInteger (denominator x)) + where x' = f e + +-- If the exponent of the nearest floating-point number to x +-- is e, then the significand is the integer nearest xb^(-e), +-- where b is the floating-point radix. We start with a good +-- guess for e, and if it is correct, the exponent of the +-- floating-point number we construct will again be e. If +-- not, one more iteration is needed. + + f e = if e' == e then y else f e' + where y = encodeFloat (round (x * (1 % b)^^e)) e + (_,e') = decodeFloat y + b = floatRadix x' + +-- We obtain a trial exponent by doing a floating-point +-- division of x's numerator by its denominator. The +-- result of this division may not itself be the ultimate +-- result, because of an accumulation of three rounding +-- errors. + + (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x' + / fromInteger (denominator x)) \end{pseudocode} Now, here's Lennart's code (which works) @@ -739,17 +739,17 @@ Now, here's Lennart's code (which works) \begin{code} -- | Converts a 'Rational' value into any type in class 'RealFloat'. {-# SPECIALISE fromRat :: Rational -> Double, - Rational -> Float #-} + Rational -> Float #-} fromRat :: (RealFloat a) => Rational -> a -- Deal with special cases first, delegating the real work to fromRat' -fromRat (n :% 0) | n > 0 = 1/0 -- +Infinity - | n == 0 = 0/0 -- NaN - | n < 0 = -1/0 -- -Infinity +fromRat (n :% 0) | n > 0 = 1/0 -- +Infinity + | n == 0 = 0/0 -- NaN + | n < 0 = -1/0 -- -Infinity fromRat (n :% d) | n > 0 = fromRat' (n :% d) - | n == 0 = encodeFloat 0 0 -- Zero - | n < 0 = - fromRat' ((-n) :% d) + | n == 0 = encodeFloat 0 0 -- Zero + | n < 0 = - fromRat' ((-n) :% d) -- Conversion process: -- Scale the rational number by the RealFloat base until @@ -764,14 +764,14 @@ fromRat' :: (RealFloat a) => Rational -> a fromRat' x = r where b = floatRadix r p = floatDigits r - (minExp0, _) = floatRange r - minExp = minExp0 - p -- the real minimum exponent - xMin = toRational (expt b (p-1)) - xMax = toRational (expt b p) - p0 = (integerLogBase b (numerator x) - integerLogBase b (denominator x) - p) `max` minExp - f = if p0 < 0 then 1 % expt b (-p0) else expt b p0 % 1 - (x', p') = scaleRat (toRational b) minExp xMin xMax p0 (x / f) - r = encodeFloat (round x') p' + (minExp0, _) = floatRange r + minExp = minExp0 - p -- the real minimum exponent + xMin = toRational (expt b (p-1)) + xMax = toRational (expt b p) + p0 = (integerLogBase b (numerator x) - integerLogBase b (denominator x) - p) `max` minExp + f = if p0 < 0 then 1 % expt b (-p0) else expt b p0 % 1 + (x', p') = scaleRat (toRational b) minExp xMin xMax p0 (x / f) + r = encodeFloat (round x') p' -- Scale x until xMin <= x < xMax, or p (the exponent) <= minExp. scaleRat :: Rational -> Int -> Rational -> Rational -> Int -> Rational -> (Rational, Int) @@ -804,21 +804,21 @@ integerLogBase b i | i < b = 0 | otherwise = doDiv (i `div` (b^l)) l where - -- Try squaring the base first to cut down the number of divisions. + -- Try squaring the base first to cut down the number of divisions. l = 2 * integerLogBase (b*b) i - doDiv :: Integer -> Int -> Int - doDiv x y - | x < b = y - | otherwise = doDiv (x `div` b) (y+1) + doDiv :: Integer -> Int -> Int + doDiv x y + | x < b = y + | otherwise = doDiv (x `div` b) (y+1) \end{code} %********************************************************* -%* * +%* * \subsection{Floating point numeric primops} -%* * +%* * %********************************************************* Definitions of the boxed PrimOps; these will be @@ -835,12 +835,12 @@ negateFloat :: Float -> Float negateFloat (F# x) = F# (negateFloat# x) gtFloat, geFloat, eqFloat, neFloat, ltFloat, leFloat :: Float -> Float -> Bool -gtFloat (F# x) (F# y) = gtFloat# x y -geFloat (F# x) (F# y) = geFloat# x y -eqFloat (F# x) (F# y) = eqFloat# x y -neFloat (F# x) (F# y) = neFloat# x y -ltFloat (F# x) (F# y) = ltFloat# x y -leFloat (F# x) (F# y) = leFloat# x y +gtFloat (F# x) (F# y) = gtFloat# x y +geFloat (F# x) (F# y) = geFloat# x y +eqFloat (F# x) (F# y) = eqFloat# x y +neFloat (F# x) (F# y) = neFloat# x y +ltFloat (F# x) (F# y) = ltFloat# x y +leFloat (F# x) (F# y) = leFloat# x y float2Int :: Float -> Int float2Int (F# x) = I# (float2Int# x) @@ -923,9 +923,9 @@ powerDouble (D# x) (D# y) = D# (x **## y) \begin{code} foreign import ccall unsafe "__encodeFloat" - encodeFloat# :: Int# -> ByteArray# -> Int -> Float + encodeFloat# :: Int# -> ByteArray# -> Int -> Float foreign import ccall unsafe "__int_encodeFloat" - int_encodeFloat# :: Int# -> Int -> Float + int_encodeFloat# :: Int# -> Int -> Float foreign import ccall unsafe "isFloatNaN" isFloatNaN :: Float -> Int @@ -935,9 +935,9 @@ foreign import ccall unsafe "isFloatNegativeZero" isFloatNegativeZero :: Float - foreign import ccall unsafe "__encodeDouble" - encodeDouble# :: Int# -> ByteArray# -> Int -> Double + encodeDouble# :: Int# -> ByteArray# -> Int -> Double foreign import ccall unsafe "__int_encodeDouble" - int_encodeDouble# :: Int# -> Int -> Double + int_encodeDouble# :: Int# -> Int -> Double foreign import ccall unsafe "isDoubleNaN" isDoubleNaN :: Double -> Int foreign import ccall unsafe "isDoubleInfinite" isDoubleInfinite :: Double -> Int @@ -946,9 +946,9 @@ foreign import ccall unsafe "isDoubleNegativeZero" isDoubleNegativeZero :: Doubl \end{code} %********************************************************* -%* * +%* * \subsection{Coercion rules} -%* * +%* * %********************************************************* \begin{code} diff --git a/GHC/Num.lhs b/GHC/Num.lhs index 708d695..40052f9 100644 --- a/GHC/Num.lhs +++ b/GHC/Num.lhs @@ -40,14 +40,14 @@ import GHC.Show infixl 7 * infixl 6 +, - -default () -- Double isn't available yet, - -- and we shouldn't be using defaults anyway +default () -- Double isn't available yet, + -- and we shouldn't be using defaults anyway \end{code} %********************************************************* -%* * +%* * \subsection{Standard numeric class} -%* * +%* * %********************************************************* \begin{code} @@ -55,11 +55,11 @@ default () -- Double isn't available yet, -- -- Minimal complete definition: all except 'negate' or @(-)@ class (Eq a, Show a) => Num a where - (+), (-), (*) :: a -> a -> a + (+), (-), (*) :: a -> a -> a -- | Unary negation. - negate :: a -> a + negate :: a -> a -- | Absolute value. - abs :: a -> a + abs :: a -> a -- | Sign of a number. -- The functions 'abs' and 'signum' should satisfy the law: -- @@ -67,15 +67,15 @@ class (Eq a, Show a) => Num a where -- -- For real numbers, the 'signum' is either @-1@ (negative), @0@ (zero) -- or @1@ (positive). - signum :: a -> a + signum :: a -> a -- | Conversion from an 'Integer'. -- An integer literal represents the application of the function -- 'fromInteger' to the appropriate value of type 'Integer', -- so such literals have type @('Num' a) => a@. - fromInteger :: Integer -> a + fromInteger :: Integer -> a - x - y = x + negate y - negate x = 0 - x + x - y = x + negate y + negate x = 0 - x -- | the same as @'flip' ('-')@. -- @@ -89,22 +89,22 @@ subtract x y = y - x %********************************************************* -%* * +%* * \subsection{Instances for @Int@} -%* * +%* * %********************************************************* \begin{code} instance Num Int where - (+) = plusInt - (-) = minusInt + (+) = plusInt + (-) = minusInt negate = negateInt - (*) = timesInt + (*) = timesInt abs n = if n `geInt` 0 then n else negateInt n signum n | n `ltInt` 0 = negateInt 1 - | n `eqInt` 0 = 0 - | otherwise = 1 + | n `eqInt` 0 = 0 + | otherwise = 1 fromInteger = integer2Int @@ -118,17 +118,17 @@ divModInt x@(I# _) y@(I# _) = (x `divInt` y, x `modInt` y) \end{code} %********************************************************* -%* * +%* * \subsection{The @Integer@ type} -%* * +%* * %********************************************************* \begin{code} -- | Arbitrary-precision integers. -data Integer - = S# Int# -- small integers +data Integer + = S# Int# -- small integers #ifndef ILX - | J# Int# ByteArray# -- large integers + | J# Int# ByteArray# -- large integers #else | J# Void BigInteger -- .NET big ints @@ -156,9 +156,9 @@ toBig i@(J# _ _) = i %********************************************************* -%* * +%* * \subsection{Dividing @Integers@} -%* * +%* * %********************************************************* \begin{code} @@ -170,8 +170,8 @@ quotRemInteger i1@(J# _ _) i2@(S# _) = quotRemInteger i1 (toBig i2) quotRemInteger i1@(S# _) i2@(J# _ _) = quotRemInteger (toBig i1) i2 quotRemInteger (J# s1 d1) (J# s2 d2) = case (quotRemInteger# s1 d1 s2 d2) of - (# s3, d3, s4, d4 #) - -> (J# s3 d3, J# s4 d4) + (# s3, d3, s4, d4 #) + -> (J# s3 d3, J# s4 d4) divModInteger a@(S# (-LEFTMOST_BIT#)) b = divModInteger (toBig a) b divModInteger (S# i) (S# j) @@ -180,8 +180,8 @@ divModInteger i1@(J# _ _) i2@(S# _) = divModInteger i1 (toBig i2) divModInteger i1@(S# _) i2@(J# _ _) = divModInteger (toBig i1) i2 divModInteger (J# s1 d1) (J# s2 d2) = case (divModInteger# s1 d1 s2 d2) of - (# s3, d3, s4, d4 #) - -> (J# s3 d3, J# s4 d4) + (# s3, d3, s4, d4 #) + -> (J# s3 d3, J# s4 d4) remInteger :: Integer -> Integer -> Integer remInteger ia ib @@ -267,9 +267,9 @@ divExact (J# sa a) (J# sb b) %********************************************************* -%* * +%* * \subsection{The @Integer@ instances for @Eq@, @Ord@} -%* * +%* * %********************************************************* \begin{code} @@ -312,26 +312,26 @@ instance Ord Integer where | otherwise = GT compare (J# s d) (S# i) = case cmpIntegerInt# s d i of { res# -> - if res# <# 0# then LT else - if res# ># 0# then GT else EQ - } + if res# <# 0# then LT else + if res# ># 0# then GT else EQ + } compare (S# i) (J# s d) = case cmpIntegerInt# s d i of { res# -> - if res# ># 0# then LT else - if res# <# 0# then GT else EQ - } + if res# ># 0# then LT else + if res# <# 0# then GT else EQ + } compare (J# s1 d1) (J# s2 d2) = case cmpInteger# s1 d1 s2 d2 of { res# -> - if res# <# 0# then LT else - if res# ># 0# then GT else EQ - } + if res# <# 0# then LT else + if res# ># 0# then GT else EQ + } \end{code} %********************************************************* -%* * +%* * \subsection{The @Integer@ instances for @Num@} -%* * +%* * %********************************************************* \begin{code} @@ -339,8 +339,8 @@ instance Num Integer where (+) = plusInteger (-) = minusInteger (*) = timesInteger - negate = negateInteger - fromInteger x = x + negate = negateInteger + fromInteger x = x -- ORIG: abs n = if n >= 0 then n else -n abs (S# (-LEFTMOST_BIT#)) = LEFTMOST_BIT @@ -350,22 +350,22 @@ instance Num Integer where signum (S# i) = case signum (I# i) of I# j -> S# j signum (J# s d) = let - cmp = cmpIntegerInt# s d 0# - in - if cmp ># 0# then S# 1# - else if cmp ==# 0# then S# 0# - else S# (negateInt# 1#) + cmp = cmpIntegerInt# s d 0# + in + if cmp ># 0# then S# 1# + else if cmp ==# 0# then S# 0# + else S# (negateInt# 1#) plusInteger i1@(S# i) i2@(S# j) = case addIntC# i j of { (# r, c #) -> - if c ==# 0# then S# r - else toBig i1 + toBig i2 } + if c ==# 0# then S# r + else toBig i1 + toBig i2 } plusInteger i1@(J# _ _) i2@(S# _) = i1 + toBig i2 plusInteger i1@(S# _) i2@(J# _ _) = toBig i1 + i2 plusInteger (J# s1 d1) (J# s2 d2) = case plusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d minusInteger i1@(S# i) i2@(S# j) = case subIntC# i j of { (# r, c #) -> - if c ==# 0# then S# r - else toBig i1 - toBig i2 } + if c ==# 0# then S# r + else toBig i1 - toBig i2 } minusInteger i1@(J# _ _) i2@(S# _) = i1 - toBig i2 minusInteger i1@(S# _) i2@(J# _ _) = toBig i1 - i2 minusInteger (J# s1 d1) (J# s2 d2) = case minusInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d @@ -378,23 +378,23 @@ timesInteger i1@(S# _) i2@(J# _ _) = toBig i1 * i2 timesInteger (J# s1 d1) (J# s2 d2) = case timesInteger# s1 d1 s2 d2 of (# s, d #) -> J# s d negateInteger (S# (-LEFTMOST_BIT#)) = LEFTMOST_BIT -negateInteger (S# i) = S# (negateInt# i) -negateInteger (J# s d) = J# (negateInt# s) d +negateInteger (S# i) = S# (negateInt# i) +negateInteger (J# s d) = J# (negateInt# s) d \end{code} %********************************************************* -%* * +%* * \subsection{The @Integer@ instance for @Enum@} -%* * +%* * %********************************************************* \begin{code} instance Enum Integer where - succ x = x + 1 - pred x = x - 1 - toEnum n = int2Integer n - fromEnum n = integer2Int n + succ x = x + 1 + pred x = x - 1 + toEnum n = int2Integer n + fromEnum n = integer2Int n {-# INLINE enumFrom #-} {-# INLINE enumFromThen #-} @@ -402,14 +402,14 @@ instance Enum Integer where {-# INLINE enumFromThenTo #-} enumFrom x = enumDeltaInteger x 1 enumFromThen x y = enumDeltaInteger x (y-x) - enumFromTo x lim = enumDeltaToInteger x 1 lim + enumFromTo x lim = enumDeltaToInteger x 1 lim enumFromThenTo x y lim = enumDeltaToInteger x (y-x) lim {-# RULES -"enumDeltaInteger" [~1] forall x y. enumDeltaInteger x y = build (\c _ -> enumDeltaIntegerFB c x y) -"efdtInteger" [~1] forall x y l.enumDeltaToInteger x y l = build (\c n -> enumDeltaToIntegerFB c n x y l) -"enumDeltaInteger" [1] enumDeltaIntegerFB (:) = enumDeltaInteger -"enumDeltaToInteger" [1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger +"enumDeltaInteger" [~1] forall x y. enumDeltaInteger x y = build (\c _ -> enumDeltaIntegerFB c x y) +"efdtInteger" [~1] forall x y l.enumDeltaToInteger x y l = build (\c n -> enumDeltaToIntegerFB c n x y l) +"enumDeltaInteger" [1] enumDeltaIntegerFB (:) = enumDeltaInteger +"enumDeltaToInteger" [1] enumDeltaToIntegerFB (:) [] = enumDeltaToInteger #-} enumDeltaIntegerFB :: (Integer -> b -> b) -> Integer -> Integer -> b @@ -427,39 +427,39 @@ enumDeltaToInteger x delta lim | otherwise = dn_list x delta lim up_fb c n x delta lim = go (x::Integer) - where - go x | x > lim = n - | otherwise = x `c` go (x+delta) + where + go x | x > lim = n + | otherwise = x `c` go (x+delta) dn_fb c n x delta lim = go (x::Integer) - where - go x | x < lim = n - | otherwise = x `c` go (x+delta) + where + go x | x < lim = n + | otherwise = x `c` go (x+delta) up_list x delta lim = go (x::Integer) - where - go x | x > lim = [] - | otherwise = x : go (x+delta) + where + go x | x > lim = [] + | otherwise = x : go (x+delta) dn_list x delta lim = go (x::Integer) - where - go x | x < lim = [] - | otherwise = x : go (x+delta) + where + go x | x < lim = [] + | otherwise = x : go (x+delta) \end{code} %********************************************************* -%* * +%* * \subsection{The @Integer@ instances for @Show@} -%* * +%* * %********************************************************* \begin{code} instance Show Integer where showsPrec p n r | p > 6 && n < 0 = '(' : jtos n (')' : r) - -- Minor point: testing p first gives better code - -- in the not-uncommon case where the p argument - -- is a constant + -- Minor point: testing p first gives better code + -- in the not-uncommon case where the p argument + -- is a constant | otherwise = jtos n r showList = showList__ (showsPrec 0) diff --git a/GHC/Read.lhs b/GHC/Read.lhs index 41c6ce4..5ec8932 100644 --- a/GHC/Read.lhs +++ b/GHC/Read.lhs @@ -16,12 +16,12 @@ ----------------------------------------------------------------------------- -- #hide -module GHC.Read +module GHC.Read ( Read(..) -- class - + -- ReadS type , ReadS -- :: *; = String -> [(a,String)] - + -- utility functions , reads -- :: Read a => ReadS a , readp -- :: Read a => ReadP a @@ -29,11 +29,11 @@ module GHC.Read , read -- :: Read a => String -> a -- H98 compatibility - , lex -- :: ReadS String - , lexLitChar -- :: ReadS String - , readLitChar -- :: ReadS Char - , lexDigits -- :: ReadS String - + , lex -- :: ReadS String + , lexLitChar -- :: ReadS String + , readLitChar -- :: ReadS Char + , lexDigits -- :: ReadS String + -- defining readers , lexP -- :: ReadPrec Lexeme , paren -- :: ReadPrec a -> ReadPrec a @@ -67,7 +67,7 @@ import Data.Maybe import Data.Either #ifndef __HADDOCK__ -import {-# SOURCE #-} GHC.Unicode ( isDigit ) +import {-# SOURCE #-} GHC.Unicode ( isDigit ) #endif import GHC.Num import GHC.Real @@ -89,17 +89,17 @@ readParen :: Bool -> ReadS a -> ReadS a readParen b g = if b then mandatory else optional where optional r = g r ++ mandatory r mandatory r = do - ("(",s) <- lex r - (x,t) <- optional s - (")",u) <- lex t - return (x,u) + ("(",s) <- lex r + (x,t) <- optional s + (")",u) <- lex t + return (x,u) \end{code} %********************************************************* -%* * +%* * \subsection{The @Read@ class} -%* * +%* * %********************************************************* \begin{code} @@ -187,10 +187,10 @@ class Read a where -- 'Text.Show.showsPrec', and delivers the value that -- 'Text.Show.showsPrec' started with. - readsPrec :: Int -- ^ the operator precedence of the enclosing - -- context (a number from @0@ to @11@). - -- Function application has precedence @10@. - -> ReadS a + readsPrec :: Int -- ^ the operator precedence of the enclosing + -- context (a number from @0@ to @11@). + -- Function application has precedence @10@. + -> ReadS a -- | The method 'readList' is provided to allow the programmer to -- give a specialised way of parsing lists of values. @@ -238,8 +238,8 @@ readEither :: Read a => String -> Either String a readEither s = case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of [x] -> Right x - [] -> Left "Prelude.read: no parse" - _ -> Left "Prelude.read: ambiguous parse" + [] -> Left "Prelude.read: no parse" + _ -> Left "Prelude.read: ambiguous parse" where read' = do x <- readPrec @@ -269,7 +269,7 @@ read s = either error id (readEither s) -- * Octal and hexadecimal numerics are not recognized as a single token -- -- * Comments are not treated properly -lex :: ReadS String -- As defined by H98 +lex :: ReadS String -- As defined by H98 lex s = readP_to_S L.hsLex s -- | Read a string representation of a character, using Haskell @@ -277,11 +277,11 @@ lex s = readP_to_S L.hsLex s -- -- > lexLitChar "\\nHello" = [("\\n", "Hello")] -- -lexLitChar :: ReadS String -- As defined by H98 +lexLitChar :: ReadS String -- As defined by H98 lexLitChar = readP_to_S (do { (s, _) <- P.gather L.lexChar ; - return s }) - -- There was a skipSpaces before the P.gather L.lexChar, - -- but that seems inconsistent with readLitChar + return s }) + -- There was a skipSpaces before the P.gather L.lexChar, + -- but that seems inconsistent with readLitChar -- | Read a string representation of a character, using Haskell -- source-language escape conventions, and convert it to the character @@ -289,7 +289,7 @@ lexLitChar = readP_to_S (do { (s, _) <- P.gather L.lexChar ; -- -- > readLitChar "\\nHello" = [('\n', "Hello")] -- -readLitChar :: ReadS Char -- As defined by H98 +readLitChar :: ReadS Char -- As defined by H98 readLitChar = readP_to_S L.lexChar -- | Reads a non-empty string of decimal digits. @@ -305,16 +305,16 @@ lexP = lift L.lex paren :: ReadPrec a -> ReadPrec a -- ^ @(paren p)@ parses \"(P0)\" --- where @p@ parses \"P0\" in precedence context zero +-- where @p@ parses \"P0\" in precedence context zero paren p = do L.Punc "(" <- lexP - x <- reset p - L.Punc ")" <- lexP - return x + x <- reset p + L.Punc ")" <- lexP + return x parens :: ReadPrec a -> ReadPrec a -- ^ @(parens p)@ parses \"P\", \"(P0)\", \"((P0))\", etc, --- where @p@ parses \"P\" in the current precedence context --- and parses \"P0\" in precedence context zero +-- where @p@ parses \"P\" in the current precedence context +-- and parses \"P0\" in precedence context zero parens p = optional where optional = p +++ mandatory @@ -346,16 +346,16 @@ choose :: [(String, ReadPrec a)] -> ReadPrec a -- Esp useful for nullary constructors; e.g. -- @choose [(\"A\", return A), (\"B\", return B)]@ choose sps = foldr ((+++) . try_one) pfail sps - where - try_one (s,p) = do { L.Ident s' <- lexP ; - if s == s' then p else pfail } + where + try_one (s,p) = do { L.Ident s' <- lexP ; + if s == s' then p else pfail } \end{code} %********************************************************* -%* * +%* * \subsection{Simple instances of Read} -%* * +%* * %********************************************************* \begin{code} @@ -368,11 +368,11 @@ instance Read Char where readListPrec = parens - ( do L.String s <- lexP -- Looks for "foo" + ( do L.String s <- lexP -- Looks for "foo" return s +++ - readListPrecDefault -- Looks for ['f','o','o'] - ) -- (more generous than H98 spec) + readListPrecDefault -- Looks for ['f','o','o'] + ) -- (more generous than H98 spec) readList = readListDefault @@ -406,9 +406,9 @@ instance Read Ordering where %********************************************************* -%* * +%* * \subsection{Structure instances of Read: Maybe, List etc} -%* * +%* * %********************************************************* For structured instances of Read we start using the precedences. The @@ -440,7 +440,7 @@ instance Read a => Read (Maybe a) where return Nothing +++ prec appPrec ( - do L.Ident "Just" <- lexP + do L.Ident "Just" <- lexP x <- step readPrec return (Just x)) ) @@ -472,10 +472,10 @@ instance Read a => Read [a] where instance (Ix a, Read a, Read b) => Read (Array a b) where readPrec = parens $ prec appPrec $ - do L.Ident "array" <- lexP - bounds <- step readPrec - vals <- step readPrec - return (array bounds vals) + do L.Ident "array" <- lexP + bounds <- step readPrec + vals <- step readPrec + return (array bounds vals) readListPrec = readListPrecDefault readList = readListDefault @@ -488,9 +488,9 @@ instance Read L.Lexeme where %********************************************************* -%* * +%* * \subsection{Numeric instances of Read} -%* * +%* * %********************************************************* \begin{code} @@ -554,9 +554,9 @@ instance (Integral a, Read a) => Read (Ratio a) where %********************************************************* -%* * - Tuple instances of Read, up to size 15 -%* * +%* * + Tuple instances of Read, up to size 15 +%* * %********************************************************* \begin{code} @@ -585,29 +585,29 @@ read_comma = do { L.Punc "," <- lexP; return () } read_tup2 :: (Read a, Read b) => ReadPrec (a,b) -- Reads "a , b" no parens! read_tup2 = do x <- readPrec - read_comma - y <- readPrec - return (x,y) + read_comma + y <- readPrec + return (x,y) read_tup4 :: (Read a, Read b, Read c, Read d) => ReadPrec (a,b,c,d) -read_tup4 = do (a,b) <- read_tup2 - read_comma - (c,d) <- read_tup2 - return (a,b,c,d) +read_tup4 = do (a,b) <- read_tup2 + read_comma + (c,d) <- read_tup2 + return (a,b,c,d) read_tup8 :: (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h) - => ReadPrec (a,b,c,d,e,f,g,h) -read_tup8 = do (a,b,c,d) <- read_tup4 - read_comma - (e,f,g,h) <- read_tup4 - return (a,b,c,d,e,f,g,h) + => ReadPrec (a,b,c,d,e,f,g,h) +read_tup8 = do (a,b,c,d) <- read_tup4 + read_comma + (e,f,g,h) <- read_tup4 + return (a,b,c,d,e,f,g,h) instance (Read a, Read b, Read c) => Read (a, b, c) where readPrec = wrap_tup (do { (a,b) <- read_tup2; read_comma - ; c <- readPrec - ; return (a,b,c) }) + ; c <- readPrec + ; return (a,b,c) }) readListPrec = readListPrecDefault readList = readListDefault @@ -618,99 +618,99 @@ instance (Read a, Read b, Read c, Read d) => Read (a, b, c, d) where instance (Read a, Read b, Read c, Read d, Read e) => Read (a, b, c, d, e) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma - ; e <- readPrec - ; return (a,b,c,d,e) }) + ; e <- readPrec + ; return (a,b,c,d,e) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f) - => Read (a, b, c, d, e, f) where + => Read (a, b, c, d, e, f) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma - ; (e,f) <- read_tup2 - ; return (a,b,c,d,e,f) }) + ; (e,f) <- read_tup2 + ; return (a,b,c,d,e,f) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g) - => Read (a, b, c, d, e, f, g) where + => Read (a, b, c, d, e, f, g) where readPrec = wrap_tup (do { (a,b,c,d) <- read_tup4; read_comma - ; (e,f) <- read_tup2; read_comma - ; g <- readPrec - ; return (a,b,c,d,e,f,g) }) + ; (e,f) <- read_tup2; read_comma + ; g <- readPrec + ; return (a,b,c,d,e,f,g) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h) - => Read (a, b, c, d, e, f, g, h) where + => Read (a, b, c, d, e, f, g, h) where readPrec = wrap_tup read_tup8 readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, - Read i) - => Read (a, b, c, d, e, f, g, h, i) where + Read i) + => Read (a, b, c, d, e, f, g, h, i) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma - ; i <- readPrec - ; return (a,b,c,d,e,f,g,h,i) }) + ; i <- readPrec + ; return (a,b,c,d,e,f,g,h,i) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, - Read i, Read j) - => Read (a, b, c, d, e, f, g, h, i, j) where + Read i, Read j) + => Read (a, b, c, d, e, f, g, h, i, j) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma - ; (i,j) <- read_tup2 - ; return (a,b,c,d,e,f,g,h,i,j) }) + ; (i,j) <- read_tup2 + ; return (a,b,c,d,e,f,g,h,i,j) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, - Read i, Read j, Read k) - => Read (a, b, c, d, e, f, g, h, i, j, k) where + Read i, Read j, Read k) + => Read (a, b, c, d, e, f, g, h, i, j, k) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma - ; (i,j) <- read_tup2; read_comma - ; k <- readPrec - ; return (a,b,c,d,e,f,g,h,i,j,k) }) + ; (i,j) <- read_tup2; read_comma + ; k <- readPrec + ; return (a,b,c,d,e,f,g,h,i,j,k) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, - Read i, Read j, Read k, Read l) - => Read (a, b, c, d, e, f, g, h, i, j, k, l) where + Read i, Read j, Read k, Read l) + => Read (a, b, c, d, e, f, g, h, i, j, k, l) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma - ; (i,j,k,l) <- read_tup4 - ; return (a,b,c,d,e,f,g,h,i,j,k,l) }) + ; (i,j,k,l) <- read_tup4 + ; return (a,b,c,d,e,f,g,h,i,j,k,l) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, - Read i, Read j, Read k, Read l, Read m) - => Read (a, b, c, d, e, f, g, h, i, j, k, l, m) where + Read i, Read j, Read k, Read l, Read m) + => Read (a, b, c, d, e, f, g, h, i, j, k, l, m) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma - ; (i,j,k,l) <- read_tup4; read_comma - ; m <- readPrec - ; return (a,b,c,d,e,f,g,h,i,j,k,l,m) }) + ; (i,j,k,l) <- read_tup4; read_comma + ; m <- readPrec + ; return (a,b,c,d,e,f,g,h,i,j,k,l,m) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, - Read i, Read j, Read k, Read l, Read m, Read n) - => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where + Read i, Read j, Read k, Read l, Read m, Read n) + => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma - ; (i,j,k,l) <- read_tup4; read_comma - ; (m,n) <- read_tup2 - ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n) }) + ; (i,j,k,l) <- read_tup4; read_comma + ; (m,n) <- read_tup2 + ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n) }) readListPrec = readListPrecDefault readList = readListDefault instance (Read a, Read b, Read c, Read d, Read e, Read f, Read g, Read h, - Read i, Read j, Read k, Read l, Read m, Read n, Read o) - => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where + Read i, Read j, Read k, Read l, Read m, Read n, Read o) + => Read (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) where readPrec = wrap_tup (do { (a,b,c,d,e,f,g,h) <- read_tup8; read_comma - ; (i,j,k,l) <- read_tup4; read_comma - ; (m,n) <- read_tup2; read_comma - ; o <- readPrec - ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) }) + ; (i,j,k,l) <- read_tup4; read_comma + ; (m,n) <- read_tup2; read_comma + ; o <- readPrec + ; return (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) }) readListPrec = readListPrecDefault readList = readListDefault \end{code} diff --git a/GHC/Real.lhs b/GHC/Real.lhs index f3c965e..f7e2eb2 100644 --- a/GHC/Real.lhs +++ b/GHC/Real.lhs @@ -29,28 +29,28 @@ infixr 8 ^, ^^ infixl 7 /, `quot`, `rem`, `div`, `mod` infixl 7 % -default () -- Double isn't available yet, - -- and we shouldn't be using defaults anyway +default () -- Double isn't available yet, + -- and we shouldn't be using defaults anyway \end{code} %********************************************************* -%* * +%* * \subsection{The @Ratio@ and @Rational@ types} -%* * +%* * %********************************************************* \begin{code} -- | Rational numbers, with numerator and denominator of some 'Integral' type. -data (Integral a) => Ratio a = !a :% !a deriving (Eq) +data (Integral a) => Ratio a = !a :% !a deriving (Eq) -- | Arbitrary-precision rational numbers, represented as a ratio of -- two 'Integer' values. A rational number may be constructed using -- the '%' operator. -type Rational = Ratio Integer +type Rational = Ratio Integer ratioPrec, ratioPrec1 :: Int -ratioPrec = 7 -- Precedence of ':%' constructor +ratioPrec = 7 -- Precedence of ':%' constructor ratioPrec1 = ratioPrec + 1 infinity, notANumber :: Rational @@ -65,17 +65,17 @@ notANumber = 0 :% 0 \begin{code} -- | Forms the ratio of two integral numbers. {-# SPECIALISE (%) :: Integer -> Integer -> Rational #-} -(%) :: (Integral a) => a -> a -> Ratio a +(%) :: (Integral a) => a -> a -> Ratio a -- | Extract the numerator of the ratio in reduced form: -- the numerator and denominator have no common factor and the denominator -- is positive. -numerator :: (Integral a) => Ratio a -> a +numerator :: (Integral a) => Ratio a -> a -- | Extract the denominator of the ratio in reduced form: -- the numerator and denominator have no common factor and the denominator -- is positive. -denominator :: (Integral a) => Ratio a -> a +denominator :: (Integral a) => Ratio a -> a \end{code} \tr{reduce} is a subsidiary function used only in this module . @@ -85,76 +85,76 @@ their greatest common divisor. \begin{code} reduce :: (Integral a) => a -> a -> Ratio a {-# SPECIALISE reduce :: Integer -> Integer -> Rational #-} -reduce _ 0 = error "Ratio.%: zero denominator" -reduce x y = (x `quot` d) :% (y `quot` d) - where d = gcd x y +reduce _ 0 = error "Ratio.%: zero denominator" +reduce x y = (x `quot` d) :% (y `quot` d) + where d = gcd x y \end{code} \begin{code} -x % y = reduce (x * signum y) (abs y) +x % y = reduce (x * signum y) (abs y) -numerator (x :% _) = x -denominator (_ :% y) = y +numerator (x :% _) = x +denominator (_ :% y) = y \end{code} %********************************************************* -%* * +%* * \subsection{Standard numeric classes} -%* * +%* * %********************************************************* \begin{code} class (Num a, Ord a) => Real a where -- | the rational equivalent of its real argument with full precision - toRational :: a -> Rational + toRational :: a -> Rational -- | Integral numbers, supporting integer division. -- -- Minimal complete definition: 'quotRem' and 'toInteger' class (Real a, Enum a) => Integral a where -- | integer division truncated toward zero - quot :: a -> a -> a + quot :: a -> a -> a -- | integer remainder, satisfying -- -- > (x `quot` y)*y + (x `rem` y) == x - rem :: a -> a -> a + rem :: a -> a -> a -- | integer division truncated toward negative infinity - div :: a -> a -> a + div :: a -> a -> a -- | integer modulus, satisfying -- -- > (x `div` y)*y + (x `mod` y) == x - mod :: a -> a -> a + mod :: a -> a -> a -- | simultaneous 'quot' and 'rem' - quotRem :: a -> a -> (a,a) + quotRem :: a -> a -> (a,a) -- | simultaneous 'div' and 'mod' - divMod :: a -> a -> (a,a) + divMod :: a -> a -> (a,a) -- | conversion to 'Integer' - toInteger :: a -> Integer + toInteger :: a -> Integer - n `quot` d = q where (q,_) = quotRem n d - n `rem` d = r where (_,r) = quotRem n d - n `div` d = q where (q,_) = divMod n d - n `mod` d = r where (_,r) = divMod n d - divMod n d = if signum r == negate (signum d) then (q-1, r+d) else qr - where qr@(q,r) = quotRem n d + n `quot` d = q where (q,_) = quotRem n d + n `rem` d = r where (_,r) = quotRem n d + n `div` d = q where (q,_) = divMod n d + n `mod` d = r where (_,r) = divMod n d + divMod n d = if signum r == negate (signum d) then (q-1, r+d) else qr + where qr@(q,r) = quotRem n d -- | Fractional numbers, supporting real division. -- -- Minimal complete definition: 'fromRational' and ('recip' or @('/')@) class (Num a) => Fractional a where -- | fractional division - (/) :: a -> a -> a + (/) :: a -> a -> a -- | reciprocal fraction - recip :: a -> a + recip :: a -> a -- | Conversion from a 'Rational' (that is @'Ratio' 'Integer'@). -- A floating literal stands for an application of 'fromRational' -- to a value of type 'Rational', so such literals have type -- @('Fractional' a) => a@. - fromRational :: Rational -> a + fromRational :: Rational -> a - recip x = 1 / x - x / y = x * recip y + recip x = 1 / x + x / y = x * recip y -- | Extracting components of fractions. -- @@ -170,65 +170,65 @@ class (Real a, Fractional a) => RealFrac a where -- -- The default definitions of the 'ceiling', 'floor', 'truncate' -- and 'round' functions are in terms of 'properFraction'. - properFraction :: (Integral b) => a -> (b,a) + properFraction :: (Integral b) => a -> (b,a) -- | @'truncate' x@ returns the integer nearest @x@ between zero and @x@ - truncate :: (Integral b) => a -> b + truncate :: (Integral b) => a -> b -- | @'round' x@ returns the nearest integer to @x@ - round :: (Integral b) => a -> b + round :: (Integral b) => a -> b -- | @'ceiling' x@ returns the least integer not less than @x@ - ceiling :: (Integral b) => a -> b + ceiling :: (Integral b) => a -> b -- | @'floor' x@ returns the greatest integer not greater than @x@ - floor :: (Integral b) => a -> b + floor :: (Integral b) => a -> b - truncate x = m where (m,_) = properFraction x + truncate x = m where (m,_) = properFraction x - round x = let (n,r) = properFraction x - m = if r < 0 then n - 1 else n + 1 - in case signum (abs r - 0.5) of - -1 -> n - 0 -> if even n then n else m - 1 -> m + round x = let (n,r) = properFraction x + m = if r < 0 then n - 1 else n + 1 + in case signum (abs r - 0.5) of + -1 -> n + 0 -> if even n then n else m + 1 -> m - ceiling x = if r > 0 then n + 1 else n - where (n,r) = properFraction x + ceiling x = if r > 0 then n + 1 else n + where (n,r) = properFraction x - floor x = if r < 0 then n - 1 else n - where (n,r) = properFraction x + floor x = if r < 0 then n - 1 else n + where (n,r) = properFraction x \end{code} These 'numeric' enumerations come straight from the Report \begin{code} -numericEnumFrom :: (Fractional a) => a -> [a] -numericEnumFrom = iterate (+1) +numericEnumFrom :: (Fractional a) => a -> [a] +numericEnumFrom = iterate (+1) -numericEnumFromThen :: (Fractional a) => a -> a -> [a] -numericEnumFromThen n m = iterate (+(m-n)) n +numericEnumFromThen :: (Fractional a) => a -> a -> [a] +numericEnumFromThen n m = iterate (+(m-n)) n numericEnumFromTo :: (Ord a, Fractional a) => a -> a -> [a] numericEnumFromTo n m = takeWhile (<= m + 1/2) (numericEnumFrom n) numericEnumFromThenTo :: (Ord a, Fractional a) => a -> a -> a -> [a] numericEnumFromThenTo e1 e2 e3 = takeWhile pred (numericEnumFromThen e1 e2) - where - mid = (e2 - e1) / 2 - pred | e2 >= e1 = (<= e3 + mid) - | otherwise = (>= e3 + mid) + where + mid = (e2 - e1) / 2 + pred | e2 >= e1 = (<= e3 + mid) + | otherwise = (>= e3 + mid) \end{code} %********************************************************* -%* * +%* * \subsection{Instances for @Int@} -%* * +%* * %********************************************************* \begin{code} instance Real Int where - toRational x = toInteger x % 1 + toRational x = toInteger x % 1 -instance Integral Int where +instance Integral Int where toInteger i = int2Integer i -- give back a full-blown Integer a `quot` b @@ -264,17 +264,17 @@ instance Integral Int where %********************************************************* -%* * +%* * \subsection{Instances for @Integer@} -%* * +%* * %********************************************************* \begin{code} instance Real Integer where - toRational x = x % 1 + toRational x = x % 1 instance Integral Integer where - toInteger n = n + toInteger n = n a `quot` 0 = divZeroError n `quot` d = n `quotInteger` d @@ -293,69 +293,69 @@ instance Integral Integer where %********************************************************* -%* * +%* * \subsection{Instances for @Ratio@} -%* * +%* * %********************************************************* \begin{code} -instance (Integral a) => Ord (Ratio a) where +instance (Integral a) => Ord (Ratio a) where {-# SPECIALIZE instance Ord Rational #-} - (x:%y) <= (x':%y') = x * y' <= x' * y - (x:%y) < (x':%y') = x * y' < x' * y + (x:%y) <= (x':%y') = x * y' <= x' * y + (x:%y) < (x':%y') = x * y' < x' * y -instance (Integral a) => Num (Ratio a) where +instance (Integral a) => Num (Ratio a) where {-# SPECIALIZE instance Num Rational #-} - (x:%y) + (x':%y') = reduce (x*y' + x'*y) (y*y') - (x:%y) - (x':%y') = reduce (x*y' - x'*y) (y*y') - (x:%y) * (x':%y') = reduce (x * x') (y * y') - negate (x:%y) = (-x) :% y - abs (x:%y) = abs x :% y - signum (x:%_) = signum x :% 1 - fromInteger x = fromInteger x :% 1 - -instance (Integral a) => Fractional (Ratio a) where + (x:%y) + (x':%y') = reduce (x*y' + x'*y) (y*y') + (x:%y) - (x':%y') = reduce (x*y' - x'*y) (y*y') + (x:%y) * (x':%y') = reduce (x * x') (y * y') + negate (x:%y) = (-x) :% y + abs (x:%y) = abs x :% y + signum (x:%_) = signum x :% 1 + fromInteger x = fromInteger x :% 1 + +instance (Integral a) => Fractional (Ratio a) where {-# SPECIALIZE instance Fractional Rational #-} - (x:%y) / (x':%y') = (x*y') % (y*x') - recip (x:%y) = y % x + (x:%y) / (x':%y') = (x*y') % (y*x') + recip (x:%y) = y % x fromRational (x:%y) = fromInteger x :% fromInteger y -instance (Integral a) => Real (Ratio a) where +instance (Integral a) => Real (Ratio a) where {-# SPECIALIZE instance Real Rational #-} - toRational (x:%y) = toInteger x :% toInteger y + toRational (x:%y) = toInteger x :% toInteger y -instance (Integral a) => RealFrac (Ratio a) where +instance (Integral a) => RealFrac (Ratio a) where {-# SPECIALIZE instance RealFrac Rational #-} properFraction (x:%y) = (fromInteger (toInteger q), r:%y) - where (q,r) = quotRem x y + where (q,r) = quotRem x y instance (Integral a) => Show (Ratio a) where {-# SPECIALIZE instance Show Rational #-} - showsPrec p (x:%y) = showParen (p > ratioPrec) $ - showsPrec ratioPrec1 x . - showString "%" . -- H98 report has spaces round the % - -- but we removed them [May 04] - showsPrec ratioPrec1 y + showsPrec p (x:%y) = showParen (p > ratioPrec) $ + showsPrec ratioPrec1 x . + showString "%" . -- H98 report has spaces round the % + -- but we removed them [May 04] + showsPrec ratioPrec1 y -instance (Integral a) => Enum (Ratio a) where +instance (Integral a) => Enum (Ratio a) where {-# SPECIALIZE instance Enum Rational #-} - succ x = x + 1 - pred x = x - 1 + succ x = x + 1 + pred x = x - 1 toEnum n = fromInteger (int2Integer n) :% 1 fromEnum = fromInteger . truncate - enumFrom = numericEnumFrom - enumFromThen = numericEnumFromThen - enumFromTo = numericEnumFromTo - enumFromThenTo = numericEnumFromThenTo + enumFrom = numericEnumFrom + enumFromThen = numericEnumFromThen + enumFromTo = numericEnumFromTo + enumFromThenTo = numericEnumFromThenTo \end{code} %********************************************************* -%* * +%* * \subsection{Coercions} -%* * +%* * %********************************************************* \begin{code} @@ -377,64 +377,64 @@ realToFrac = fromRational . toRational \end{code} %********************************************************* -%* * +%* * \subsection{Overloaded numeric functions} -%* * +%* * %********************************************************* \begin{code} -- | Converts a possibly-negative 'Real' value to a string. showSigned :: (Real a) - => (a -> ShowS) -- ^ a function that can show unsigned values - -> Int -- ^ the precedence of the enclosing context - -> a -- ^ the value to show + => (a -> ShowS) -- ^ a function that can show unsigned values + -> Int -- ^ the precedence of the enclosing context + -> a -- ^ the value to show -> ShowS showSigned showPos p x | x < 0 = showParen (p > 6) (showChar '-' . showPos (-x)) | otherwise = showPos x -even, odd :: (Integral a) => a -> Bool -even n = n `rem` 2 == 0 -odd = not . even +even, odd :: (Integral a) => a -> Bool +even n = n `rem` 2 == 0 +odd = not . even ------------------------------------------------------- -- | raise a number to a non-negative integral power {-# SPECIALISE (^) :: - Integer -> Integer -> Integer, - Integer -> Int -> Integer, - Int -> Int -> Int #-} -(^) :: (Num a, Integral b) => a -> b -> a -_ ^ 0 = 1 -x ^ n | n > 0 = f x (n-1) x - where f _ 0 y = y - f a d y = g a d where - g b i | even i = g (b*b) (i `quot` 2) - | otherwise = f b (i-1) (b*y) -_ ^ _ = error "Prelude.^: negative exponent" + Integer -> Integer -> Integer, + Integer -> Int -> Integer, + Int -> Int -> Int #-} +(^) :: (Num a, Integral b) => a -> b -> a +_ ^ 0 = 1 +x ^ n | n > 0 = f x (n-1) x + where f _ 0 y = y + f a d y = g a d where + g b i | even i = g (b*b) (i `quot` 2) + | otherwise = f b (i-1) (b*y) +_ ^ _ = error "Prelude.^: negative exponent" -- | raise a number to an integral power {-# SPECIALISE (^^) :: - Rational -> Int -> Rational #-} -(^^) :: (Fractional a, Integral b) => a -> b -> a -x ^^ n = if n >= 0 then x^n else recip (x^(negate n)) + Rational -> Int -> Rational #-} +(^^) :: (Fractional a, Integral b) => a -> b -> a +x ^^ n = if n >= 0 then x^n else recip (x^(negate n)) ------------------------------------------------------- -- | @'gcd' x y@ is the greatest (positive) integer that divides both @x@ -- and @y@; for example @'gcd' (-3) 6@ = @3@, @'gcd' (-3) (-6)@ = @3@, -- @'gcd' 0 4@ = @4@. @'gcd' 0 0@ raises a runtime error. -gcd :: (Integral a) => a -> a -> a -gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined" -gcd x y = gcd' (abs x) (abs y) - where gcd' a 0 = a - gcd' a b = gcd' b (a `rem` b) +gcd :: (Integral a) => a -> a -> a +gcd 0 0 = error "Prelude.gcd: gcd 0 0 is undefined" +gcd x y = gcd' (abs x) (abs y) + where gcd' a 0 = a + gcd' a b = gcd' b (a `rem` b) -- | @'lcm' x y@ is the smallest positive integer that both @x@ and @y@ divide. -lcm :: (Integral a) => a -> a -> a +lcm :: (Integral a) => a -> a -> a {-# SPECIALISE lcm :: Int -> Int -> Int #-} -lcm _ 0 = 0 -lcm 0 _ = 0 -lcm x y = abs ((x `quot` (gcd x y)) * y) +lcm _ 0 = 0 +lcm 0 _ = 0 +lcm x y = abs ((x `quot` (gcd x y)) * y) {-# RULES diff --git a/GHC/ST.lhs b/GHC/ST.lhs index 8642bbb..15ff74c 100644 --- a/GHC/ST.lhs +++ b/GHC/ST.lhs @@ -26,9 +26,9 @@ default () \end{code} %********************************************************* -%* * +%* * \subsection{The @ST@ monad} -%* * +%* * %********************************************************* The state-transformer monad proper. By default the monad is strict; @@ -69,9 +69,9 @@ instance Monad (ST s) where (ST m) >>= k = ST (\ s -> - case (m s) of { (# new_s, r #) -> - case (k r) of { ST k2 -> - (k2 new_s) }}) + case (m s) of { (# new_s, r #) -> + case (k r) of { ST k2 -> + (k2 new_s) }}) data STret s a = STret (State# s) a @@ -84,7 +84,7 @@ liftST (ST m) = \s -> case m s of (# s', r #) -> STret s' r unsafeInterleaveST :: ST s a -> ST s a unsafeInterleaveST (ST m) = ST ( \ s -> let - r = case m s of (# _, res #) -> res + r = case m s of (# _, res #) -> res in (# s, r #) ) @@ -95,13 +95,13 @@ unsafeInterleaveST (ST m) = ST ( \ s -> fixST :: (a -> ST s a) -> ST s a fixST k = ST $ \ s -> let ans = liftST (k r) s - STret _ r = ans + STret _ r = ans in case ans of STret s' x -> (# s', x #) instance Show (ST s a) where showsPrec _ _ = showString "<>" - showList = showList__ (showsPrec 0) + showList = showList__ (showsPrec 0) \end{code} Definition of runST @@ -111,16 +111,16 @@ SLPJ 95/04: Why @runST@ must not have an unfolding; consider: \begin{verbatim} f x = runST ( \ s -> let - (a, s') = newArray# 100 [] s - (_, s'') = fill_in_array_or_something a x s' - in - freezeArray# a s'' ) + (a, s') = newArray# 100 [] s + (_, s'') = fill_in_array_or_something a x s' + in + freezeArray# a s'' ) \end{verbatim} If we inline @runST@, we'll get: \begin{verbatim} f x = let - (a, s') = newArray# 100 [] realWorld#{-NB-} - (_, s'') = fill_in_array_or_something a x s' + (a, s') = newArray# 100 [] realWorld#{-NB-} + (_, s'') = fill_in_array_or_something a x s' in freezeArray# a s'' \end{verbatim} @@ -131,8 +131,8 @@ f = let (a, s') = newArray# 100 [] realWorld#{-NB-} -- YIKES!!! in \ x -> - let (_, s'') = fill_in_array_or_something a x s' in - freezeArray# a s'' + let (_, s'') = fill_in_array_or_something a x s' in + freezeArray# a s'' \end{verbatim} All calls to @f@ will share a {\em single} array! End SLPJ 95/04. @@ -150,7 +150,7 @@ runST st = runSTRep (case st of { ST st_rep -> st_rep }) -- I'm only letting runSTRep be inlined right at the end, in particular *after* full laziness -- That's what the "INLINE [0]" says. --- SLPJ Apr 99 +-- SLPJ Apr 99 -- {-# INLINE [0] runSTRep #-} -- SDM: further to the above, inline phase 0 is run *before* @@ -161,5 +161,5 @@ runST st = runSTRep (case st of { ST st_rep -> st_rep }) {-# NOINLINE runSTRep #-} runSTRep :: (forall s. STRep s a) -> a runSTRep st_rep = case st_rep realWorld# of - (# _, r #) -> r + (# _, r #) -> r \end{code} diff --git a/GHC/Show.lhs b/GHC/Show.lhs index c705669..30858da 100644 --- a/GHC/Show.lhs +++ b/GHC/Show.lhs @@ -17,26 +17,26 @@ -- #hide module GHC.Show - ( - Show(..), ShowS, + ( + Show(..), ShowS, - -- Instances for Show: (), [], Bool, Ordering, Int, Char + -- Instances for Show: (), [], Bool, Ordering, Int, Char - -- Show support code - shows, showChar, showString, showParen, showList__, showSpace, - showLitChar, protectEsc, - intToDigit, showSignedInt, - appPrec, appPrec1, + -- Show support code + shows, showChar, showString, showParen, showList__, showSpace, + showLitChar, protectEsc, + intToDigit, showSignedInt, + appPrec, appPrec1, - -- Character operations - asciiTab, - ) - where + -- Character operations + asciiTab, + ) + where import GHC.Base import Data.Maybe import Data.Either -import GHC.List ( (!!), foldr1 +import GHC.List ( (!!), foldr1 #ifdef USE_REPORT_PRELUDE , concatMap #endif @@ -46,9 +46,9 @@ import GHC.List ( (!!), foldr1 %********************************************************* -%* * +%* * \subsection{The @Show@ class} -%* * +%* * %********************************************************* \begin{code} @@ -123,11 +123,11 @@ class Show a where -- That is, 'Text.Read.readsPrec' parses the string produced by -- 'showsPrec', and delivers the value that 'showsPrec' started with. - showsPrec :: Int -- ^ the operator precedence of the enclosing - -- context (a number from @0@ to @11@). - -- Function application has precedence @10@. - -> a -- ^ the value to be converted to a 'String' - -> ShowS + showsPrec :: Int -- ^ the operator precedence of the enclosing + -- context (a number from @0@ to @11@). + -- Function application has precedence @10@. + -> a -- ^ the value to be converted to a 'String' + -> ShowS -- | A specialised variant of 'showsPrec', using precedence context -- zero, and returning an ordinary 'String'. @@ -152,16 +152,16 @@ showList__ showx (x:xs) s = '[' : showx x (showl xs) showl (y:ys) = ',' : showx y (showl ys) appPrec, appPrec1 :: Int - -- Use unboxed stuff because we don't have overloaded numerics yet -appPrec = I# 10# -- Precedence of application: - -- one more than the maximum operator precedence of 9 -appPrec1 = I# 11# -- appPrec + 1 + -- Use unboxed stuff because we don't have overloaded numerics yet +appPrec = I# 10# -- Precedence of application: + -- one more than the maximum operator precedence of 9 +appPrec1 = I# 11# -- appPrec + 1 \end{code} %********************************************************* -%* * +%* * \subsection{Simple Instances} -%* * +%* * %********************************************************* \begin{code} @@ -186,13 +186,13 @@ instance Show Char where showsPrec _ c = showChar '\'' . showLitChar c . showChar '\'' showList cs = showChar '"' . showl cs - where showl "" s = showChar '"' s - showl ('"':xs) s = showString "\\\"" (showl xs s) - showl (x:xs) s = showLitChar x (showl xs s) - -- Making 's' an explicit parameter makes it clear to GHC - -- that showl has arity 2, which avoids it allocating an extra lambda - -- The sticking point is the recursive call to (showl xs), which - -- it can't figure out would be ok with arity 2. + where showl "" s = showChar '"' s + showl ('"':xs) s = showString "\\\"" (showl xs s) + showl (x:xs) s = showLitChar x (showl xs s) + -- Making 's' an explicit parameter makes it clear to GHC + -- that showl has arity 2, which avoids it allocating an extra lambda + -- The sticking point is the recursive call to (showl xs), which + -- it can't figure out would be ok with arity 2. instance Show Int where showsPrec = showSignedInt @@ -201,31 +201,31 @@ instance Show a => Show (Maybe a) where showsPrec _p Nothing s = showString "Nothing" s showsPrec p (Just x) s = (showParen (p > appPrec) $ - showString "Just " . - showsPrec appPrec1 x) s + showString "Just " . + showsPrec appPrec1 x) s instance (Show a, Show b) => Show (Either a b) where showsPrec p e s = (showParen (p > appPrec) $ case e of Left a -> showString "Left " . showsPrec appPrec1 a - Right b -> showString "Right " . showsPrec appPrec1 b) + Right b -> showString "Right " . showsPrec appPrec1 b) s \end{code} %********************************************************* -%* * +%* * \subsection{Show instances for the first few tuples -%* * +%* * %********************************************************* \begin{code} -- The explicit 's' parameters are important -- Otherwise GHC thinks that "shows x" might take a lot of work to compute -- and generates defns like --- showsPrec _ (x,y) = let sx = shows x; sy = shows y in --- \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s)))) +-- showsPrec _ (x,y) = let sx = shows x; sy = shows y in +-- \s -> showChar '(' (sx (showChar ',' (sy (showChar ')' s)))) instance (Show a, Show b) => Show (a,b) where showsPrec _ (a,b) s = show_tuple [shows a, shows b] s @@ -243,72 +243,72 @@ instance (Show a, Show b, Show c, Show d, Show e, Show f) => Show (a,b,c,d,e,f) showsPrec _ (a,b,c,d,e,f) s = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g) - => Show (a,b,c,d,e,f,g) where + => Show (a,b,c,d,e,f,g) where showsPrec _ (a,b,c,d,e,f,g) s - = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s + = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h) - => Show (a,b,c,d,e,f,g,h) where + => Show (a,b,c,d,e,f,g,h) where showsPrec _ (a,b,c,d,e,f,g,h) s - = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h] s + = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i) - => Show (a,b,c,d,e,f,g,h,i) where + => Show (a,b,c,d,e,f,g,h,i) where showsPrec _ (a,b,c,d,e,f,g,h,i) s - = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, - shows i] s + = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, + shows i] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j) - => Show (a,b,c,d,e,f,g,h,i,j) where + => Show (a,b,c,d,e,f,g,h,i,j) where showsPrec _ (a,b,c,d,e,f,g,h,i,j) s - = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, - shows i, shows j] s + = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, + shows i, shows j] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k) - => Show (a,b,c,d,e,f,g,h,i,j,k) where + => Show (a,b,c,d,e,f,g,h,i,j,k) where showsPrec _ (a,b,c,d,e,f,g,h,i,j,k) s - = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, - shows i, shows j, shows k] s + = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, + shows i, shows j, shows k] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, - Show l) - => Show (a,b,c,d,e,f,g,h,i,j,k,l) where + Show l) + => Show (a,b,c,d,e,f,g,h,i,j,k,l) where showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l) s - = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, - shows i, shows j, shows k, shows l] s + = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, + shows i, shows j, shows k, shows l] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, - Show l, Show m) - => Show (a,b,c,d,e,f,g,h,i,j,k,l,m) where + Show l, Show m) + => Show (a,b,c,d,e,f,g,h,i,j,k,l,m) where showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m) s - = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, - shows i, shows j, shows k, shows l, shows m] s + = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, + shows i, shows j, shows k, shows l, shows m] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, - Show l, Show m, Show n) - => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where + Show l, Show m, Show n) + => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n) where showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n) s - = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, - shows i, shows j, shows k, shows l, shows m, shows n] s + = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, + shows i, shows j, shows k, shows l, shows m, shows n] s instance (Show a, Show b, Show c, Show d, Show e, Show f, Show g, Show h, Show i, Show j, Show k, - Show l, Show m, Show n, Show o) - => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where + Show l, Show m, Show n, Show o) + => Show (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) where showsPrec _ (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) s - = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, - shows i, shows j, shows k, shows l, shows m, shows n, shows o] s + = show_tuple [shows a, shows b, shows c, shows d, shows e, shows f, shows g, shows h, + shows i, shows j, shows k, shows l, shows m, shows n, shows o] s show_tuple :: [ShowS] -> ShowS show_tuple ss = showChar '(' - . foldr1 (\s r -> s . showChar ',' . r) ss - . showChar ')' + . foldr1 (\s r -> s . showChar ',' . r) ss + . showChar ')' \end{code} %********************************************************* -%* * +%* * \subsection{Support code for @Show@} -%* * +%* * %********************************************************* \begin{code} @@ -343,38 +343,38 @@ Code specific for characters -- -- > showLitChar '\n' s = "\\n" ++ s -- -showLitChar :: Char -> ShowS +showLitChar :: Char -> ShowS showLitChar c s | c > '\DEL' = showChar '\\' (protectEsc isDec (shows (ord c)) s) -showLitChar '\DEL' s = showString "\\DEL" s -showLitChar '\\' s = showString "\\\\" s +showLitChar '\DEL' s = showString "\\DEL" s +showLitChar '\\' s = showString "\\\\" s showLitChar c s | c >= ' ' = showChar c s -showLitChar '\a' s = showString "\\a" s -showLitChar '\b' s = showString "\\b" s -showLitChar '\f' s = showString "\\f" s -showLitChar '\n' s = showString "\\n" s -showLitChar '\r' s = showString "\\r" s -showLitChar '\t' s = showString "\\t" s -showLitChar '\v' s = showString "\\v" s -showLitChar '\SO' s = protectEsc (== 'H') (showString "\\SO") s -showLitChar c s = showString ('\\' : asciiTab!!ord c) s - -- I've done manual eta-expansion here, becuase otherwise it's - -- impossible to stop (asciiTab!!ord) getting floated out as an MFE +showLitChar '\a' s = showString "\\a" s +showLitChar '\b' s = showString "\\b" s +showLitChar '\f' s = showString "\\f" s +showLitChar '\n' s = showString "\\n" s +showLitChar '\r' s = showString "\\r" s +showLitChar '\t' s = showString "\\t" s +showLitChar '\v' s = showString "\\v" s +showLitChar '\SO' s = protectEsc (== 'H') (showString "\\SO") s +showLitChar c s = showString ('\\' : asciiTab!!ord c) s + -- I've done manual eta-expansion here, becuase otherwise it's + -- impossible to stop (asciiTab!!ord) getting floated out as an MFE isDec c = c >= '0' && c <= '9' protectEsc :: (Char -> Bool) -> ShowS -> ShowS -protectEsc p f = f . cont - where cont s@(c:_) | p c = "\\&" ++ s - cont s = s +protectEsc p f = f . cont + where cont s@(c:_) | p c = "\\&" ++ s + cont s = s asciiTab :: [String] asciiTab = -- Using an array drags in the array module. listArray ('\NUL', ' ') - ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL", - "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI", - "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB", - "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US", - "SP"] + ["NUL", "SOH", "STX", "ETX", "EOT", "ENQ", "ACK", "BEL", + "BS", "HT", "LF", "VT", "FF", "CR", "SO", "SI", + "DLE", "DC1", "DC2", "DC3", "DC4", "NAK", "SYN", "ETB", + "CAN", "EM", "SUB", "ESC", "FS", "GS", "RS", "US", + "SP"] \end{code} Code specific for Ints. @@ -387,7 +387,7 @@ intToDigit :: Int -> Char intToDigit (I# i) | i >=# 0# && i <=# 9# = unsafeChr (ord '0' `plusInt` I# i) | i >=# 10# && i <=# 15# = unsafeChr (ord 'a' `minusInt` ten `plusInt` I# i) - | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i)) + | otherwise = error ("Char.intToDigit: not a digit " ++ show (I# i)) ten = I# 10# @@ -399,17 +399,17 @@ showSignedInt (I# p) (I# n) r itos :: Int# -> String -> String itos n# cs | n# <# 0# = - let I# minInt# = minInt in - if n# ==# minInt# - -- negateInt# minInt overflows, so we can't do that: - then '-' : itos' (negateInt# (n# `quotInt#` 10#)) + let I# minInt# = minInt in + if n# ==# minInt# + -- negateInt# minInt overflows, so we can't do that: + then '-' : itos' (negateInt# (n# `quotInt#` 10#)) (itos' (negateInt# (n# `remInt#` 10#)) cs) - else '-' : itos' (negateInt# n#) cs + else '-' : itos' (negateInt# n#) cs | otherwise = itos' n# cs where itos' :: Int# -> String -> String itos' n# cs | n# <# 10# = C# (chr# (ord# '0'# +# n#)) : cs | otherwise = case chr# (ord# '0'# +# (n# `remInt#` 10#)) of { c# -> - itos' (n# `quotInt#` 10#) (C# c# : cs) } + itos' (n# `quotInt#` 10#) (C# c# : cs) } \end{code} diff --git a/GHC/Unicode.hs b/GHC/Unicode.hs index 2cfaf09..20d2b09 100644 --- a/GHC/Unicode.hs +++ b/GHC/Unicode.hs @@ -32,14 +32,14 @@ import GHC.Base import GHC.Real (fromIntegral) import GHC.Int import GHC.Word -import GHC.Num (fromInteger) +import GHC.Num (fromInteger) #include "HsBaseConfig.h" -- | Selects the first 128 characters of the Unicode character set, -- corresponding to the ASCII character set. isAscii :: Char -> Bool -isAscii c = c < '\x80' +isAscii c = c < '\x80' -- | Selects the first 256 characters of the Unicode character set, -- corresponding to the ISO 8859-1 (Latin-1) character set. @@ -70,14 +70,14 @@ isSpace :: Char -> Bool -- isSpace includes non-breaking space -- Done with explicit equalities both for efficiency, and to avoid a tiresome -- recursion with GHC.List elem -isSpace c = c == ' ' || - c == '\t' || - c == '\n' || - c == '\r' || - c == '\f' || - c == '\v' || - c == '\xa0' || - iswspace (fromIntegral (ord c)) /= 0 +isSpace c = c == ' ' || + c == '\t' || + c == '\n' || + c == '\r' || + c == '\f' || + c == '\v' || + c == '\xa0' || + iswspace (fromIntegral (ord c)) /= 0 -- | Selects upper-case or title-case alphabetic Unicode characters (letters). -- Title case is used by a small number of letter ligatures like the @@ -101,16 +101,16 @@ isAlphaNum :: Char -> Bool -- | Selects ASCII digits, i.e. @\'0\'@..@\'9\'@. isDigit :: Char -> Bool -isDigit c = c >= '0' && c <= '9' +isDigit c = c >= '0' && c <= '9' -- | Selects ASCII octal digits, i.e. @\'0\'@..@\'7\'@. isOctDigit :: Char -> Bool -isOctDigit c = c >= '0' && c <= '7' +isOctDigit c = c >= '0' && c <= '7' -- | Selects ASCII hexadecimal digits, -- i.e. @\'0\'@..@\'9\'@, @\'a\'@..@\'f\'@, @\'A\'@..@\'F\'@. isHexDigit :: Char -> Bool -isHexDigit c = isDigit c || c >= 'A' && c <= 'F' || +isHexDigit c = isDigit c || c >= 'A' && c <= 'F' || c >= 'a' && c <= 'f' -- | Convert a letter to the corresponding upper-case letter, if any. @@ -190,22 +190,22 @@ foreign import ccall unsafe "u_gencat" #else -isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f' -isPrint c = not (isControl c) +isControl c = c < ' ' || c >= '\DEL' && c <= '\x9f' +isPrint c = not (isControl c) -- The upper case ISO characters have the multiplication sign dumped -- randomly in the middle of the range. Go figure. -isUpper c = c >= 'A' && c <= 'Z' || +isUpper c = c >= 'A' && c <= 'Z' || c >= '\xC0' && c <= '\xD6' || c >= '\xD8' && c <= '\xDE' -- The lower case ISO characters have the division sign dumped -- randomly in the middle of the range. Go figure. -isLower c = c >= 'a' && c <= 'z' || +isLower c = c >= 'a' && c <= 'z' || c >= '\xDF' && c <= '\xF6' || c >= '\xF8' && c <= '\xFF' -isAlpha c = isLower c || isUpper c -isAlphaNum c = isAlpha c || isDigit c +isAlpha c = isLower c || isUpper c +isAlphaNum c = isAlpha c || isDigit c -- Case-changing operations @@ -213,7 +213,7 @@ toUpper c@(C# c#) | isAsciiLower c = C# (chr# (ord# c# -# 32#)) | isAscii c = c -- fall-through to the slower stuff. - | isLower c && c /= '\xDF' && c /= '\xFF' + | isLower c && c /= '\xDF' && c /= '\xFF' = unsafeChr (ord c `minusInt` ord 'a' `plusInt` ord 'A') | otherwise = c @@ -222,8 +222,8 @@ toUpper c@(C# c#) toLower c@(C# c#) | isAsciiUpper c = C# (chr# (ord# c# +# 32#)) | isAscii c = c - | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a') - | otherwise = c + | isUpper c = unsafeChr (ord c `minusInt` ord 'A' `plusInt` ord 'a') + | otherwise = c #endif diff --git a/GHC/Unicode.hs-boot b/GHC/Unicode.hs-boot index 1690110..cc67ac8 100644 --- a/GHC/Unicode.hs-boot +++ b/GHC/Unicode.hs-boot @@ -3,15 +3,15 @@ module GHC.Unicode where import GHC.Base( Char, Bool ) -isAscii :: Char -> Bool -isLatin1 :: Char -> Bool -isControl :: Char -> Bool -isPrint :: Char -> Bool -isSpace :: Char -> Bool -isUpper :: Char -> Bool -isLower :: Char -> Bool -isAlpha :: Char -> Bool -isDigit :: Char -> Bool -isOctDigit :: Char -> Bool -isHexDigit :: Char -> Bool -isAlphaNum :: Char -> Bool +isAscii :: Char -> Bool +isLatin1 :: Char -> Bool +isControl :: Char -> Bool +isPrint :: Char -> Bool +isSpace :: Char -> Bool +isUpper :: Char -> Bool +isLower :: Char -> Bool +isAlpha :: Char -> Bool +isDigit :: Char -> Bool +isOctDigit :: Char -> Bool +isHexDigit :: Char -> Bool +isAlphaNum :: Char -> Bool diff --git a/GHC/Word.hs b/GHC/Word.hs index 4e35965..dbb1bb3 100644 --- a/GHC/Word.hs +++ b/GHC/Word.hs @@ -169,7 +169,7 @@ instance Bits Word where | otherwise = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#))) where i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#)) - wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -} + wsib = WORD_SIZE_IN_BITS# {- work around preprocessor problem (??) -} bitSize _ = WORD_SIZE_IN_BITS isSigned _ = False @@ -741,10 +741,10 @@ instance Bits Word64 where shiftL64#, shiftRL64# :: Word64# -> Int# -> Word64# a `shiftL64#` b | b >=# 64# = wordToWord64# (int2Word# 0#) - | otherwise = a `uncheckedShiftL64#` b + | otherwise = a `uncheckedShiftL64#` b a `shiftRL64#` b | b >=# 64# = wordToWord64# (int2Word# 0#) - | otherwise = a `uncheckedShiftRL64#` b + | otherwise = a `uncheckedShiftRL64#` b foreign import ccall unsafe "hs_eqWord64" eqWord64# :: Word64# -> Word64# -> Bool diff --git a/Text/Read/Lex.hs b/Text/Read/Lex.hs index 740e27f..cbfaaf8 100644 --- a/Text/Read/Lex.hs +++ b/Text/Read/Lex.hs @@ -16,12 +16,12 @@ module Text.Read.Lex -- lexing types ( Lexeme(..) -- :: *; Show, Eq - - -- lexer - , lex -- :: ReadP Lexeme Skips leading spaces - , hsLex -- :: ReadP String - , lexChar -- :: ReadP Char Reads just one char, with H98 escapes - + + -- lexer + , lex -- :: ReadP Lexeme Skips leading spaces + , hsLex -- :: ReadP String + , lexChar -- :: ReadP Char Reads just one char, with H98 escapes + , readIntP -- :: Num a => a -> (Char -> Bool) -> (Char -> Int) -> ReadP a , readOctP -- :: Num a => ReadP a , readDecP -- :: Num a => ReadP a @@ -39,7 +39,7 @@ import GHC.Show( Show(..) ) import {-# SOURCE #-} GHC.Unicode ( isSpace, isAlpha, isAlphaNum ) #endif import GHC.Real( Ratio(..), Integral, Rational, (%), fromIntegral, - toInteger, (^), (^^), infinity, notANumber ) + toInteger, (^), (^^), infinity, notANumber ) import GHC.List import GHC.Enum( maxBound ) #else @@ -58,13 +58,13 @@ import Control.Monad -- ^ Haskell lexemes. data Lexeme - = Char Char -- ^ Character literal - | String String -- ^ String literal, with escapes interpreted - | Punc String -- ^ Punctuation or reserved symbol, e.g. @(@, @::@ - | Ident String -- ^ Haskell identifier, e.g. @foo@, @Baz@ - | Symbol String -- ^ Haskell symbol, e.g. @>>@, @:%@ - | Int Integer -- ^ Integer literal - | Rat Rational -- ^ Floating point literal + = Char Char -- ^ Character literal + | String String -- ^ String literal, with escapes interpreted + | Punc String -- ^ Punctuation or reserved symbol, e.g. @(@, @::@ + | Ident String -- ^ Haskell identifier, e.g. @foo@, @Baz@ + | Symbol String -- ^ Haskell symbol, e.g. @>>@, @:%@ + | Int Integer -- ^ Integer literal + | Rat Rational -- ^ Floating point literal | EOF deriving (Eq, Show) @@ -77,25 +77,25 @@ lex = skipSpaces >> lexToken hsLex :: ReadP String -- ^ Haskell lexer: returns the lexed string, rather than the lexeme hsLex = do skipSpaces - (s,_) <- gather lexToken - return s + (s,_) <- gather lexToken + return s lexToken :: ReadP Lexeme lexToken = lexEOF +++ - lexLitChar +++ - lexString +++ - lexPunc +++ - lexSymbol +++ - lexId +++ - lexNumber + lexLitChar +++ + lexString +++ + lexPunc +++ + lexSymbol +++ + lexId +++ + lexNumber -- ---------------------------------------------------------------------- -- End of file lexEOF :: ReadP Lexeme lexEOF = do s <- look - guard (null s) - return EOF + guard (null s) + return EOF -- --------------------------------------------------------------------------- -- Single character lexemes @@ -114,9 +114,9 @@ lexSymbol :: ReadP Lexeme lexSymbol = do s <- munch1 isSymbolChar if s `elem` reserved_ops then - return (Punc s) -- Reserved-ops count as punctuation + return (Punc s) -- Reserved-ops count as punctuation else - return (Symbol s) + return (Symbol s) where isSymbolChar c = c `elem` "!@#$%&*+./<=>?\\^|:-~" reserved_ops = ["..", "::", "=", "\\", "|", "<-", "->", "@", "~", "=>"] @@ -127,16 +127,16 @@ lexSymbol = lexId :: ReadP Lexeme lexId = lex_nan <++ lex_id where - -- NaN and Infinity look like identifiers, so - -- we parse them first. + -- NaN and Infinity look like identifiers, so + -- we parse them first. lex_nan = (string "NaN" >> return (Rat notANumber)) +++ - (string "Infinity" >> return (Rat infinity)) + (string "Infinity" >> return (Rat infinity)) lex_id = do c <- satisfy isIdsChar - s <- munch isIdfChar - return (Ident (c:s)) + s <- munch isIdfChar + return (Ident (c:s)) - -- Identifiers can start with a '_' + -- Identifiers can start with a '_' isIdsChar c = isAlpha c || c == '_' isIdfChar c = isAlphaNum c || c `elem` "_'" @@ -153,7 +153,7 @@ lexLitChar :: ReadP Lexeme lexLitChar = do char '\'' (c,esc) <- lexCharE - guard (esc || c /= '\'') -- Eliminate '' possibility + guard (esc || c /= '\'') -- Eliminate '' possibility char '\'' return (Char c) @@ -235,9 +235,9 @@ lexCharE = lexAscii = do choice [ (string "SOH" >> return '\SOH') <++ - (string "SO" >> return '\SO') - -- \SO and \SOH need maximal-munch treatment - -- See the Haskell report Sect 2.6 + (string "SO" >> return '\SO') + -- \SO and \SOH need maximal-munch treatment + -- See the Haskell report Sect 2.6 , string "NUL" >> return '\NUL' , string "STX" >> return '\STX' @@ -287,10 +287,10 @@ lexString = if c /= '"' || esc then body (f.(c:)) else let s = f "" in - return (String s) + return (String s) lexStrItem = (lexEmpty >> lexStrItem) - +++ lexCharE + +++ lexCharE lexEmpty = do char '\\' @@ -308,26 +308,26 @@ type Digits = [Int] lexNumber :: ReadP Lexeme lexNumber - = lexHexOct <++ -- First try for hex or octal 0x, 0o etc - -- If that fails, try for a decimal number - lexDecNumber -- Start with ordinary digits - + = lexHexOct <++ -- First try for hex or octal 0x, 0o etc + -- If that fails, try for a decimal number + lexDecNumber -- Start with ordinary digits + lexHexOct :: ReadP Lexeme lexHexOct - = do char '0' - base <- lexBaseChar - digits <- lexDigits base - return (Int (val (fromIntegral base) 0 digits)) + = do char '0' + base <- lexBaseChar + digits <- lexDigits base + return (Int (val (fromIntegral base) 0 digits)) lexBaseChar :: ReadP Int -- Lex a single character indicating the base; fail if not there lexBaseChar = do { c <- get; - case c of - 'o' -> return 8 - 'O' -> return 8 - 'x' -> return 16 - 'X' -> return 16 - _ -> pfail } + case c of + 'o' -> return 8 + 'O' -> return 8 + 'x' -> return 16 + 'X' -> return 16 + _ -> pfail } lexDecNumber :: ReadP Lexeme lexDecNumber = @@ -339,19 +339,19 @@ lexDecNumber = value xs mFrac mExp = valueFracExp (val 10 0 xs) mFrac mExp valueFracExp :: Integer -> Maybe Digits -> Maybe Integer - -> Lexeme - valueFracExp a Nothing Nothing - = Int a -- 43 + -> Lexeme + valueFracExp a Nothing Nothing + = Int a -- 43 valueFracExp a Nothing (Just exp) - | exp >= 0 = Int (a * (10 ^ exp)) -- 43e7 - | otherwise = Rat (valExp (fromInteger a) exp) -- 43e-7 + | exp >= 0 = Int (a * (10 ^ exp)) -- 43e7 + | otherwise = Rat (valExp (fromInteger a) exp) -- 43e-7 valueFracExp a (Just fs) mExp = case mExp of - Nothing -> Rat rat -- 4.3 - Just exp -> Rat (valExp rat exp) -- 4.3e-4 + Nothing -> Rat rat -- 4.3 + Just exp -> Rat (valExp rat exp) -- 4.3e-4 where - rat :: Rational - rat = fromInteger a + frac 10 0 1 fs + rat :: Rational + rat = fromInteger a + frac 10 0 1 fs valExp :: Rational -> Integer -> Rational valExp rat exp = rat * (10 ^^ exp) @@ -360,13 +360,13 @@ lexFrac :: ReadP (Maybe Digits) -- Read the fractional part; fail if it doesn't -- start ".d" where d is a digit lexFrac = do char '.' - frac <- lexDigits 10 - return (Just frac) + frac <- lexDigits 10 + return (Just frac) lexExp :: ReadP (Maybe Integer) lexExp = do char 'e' +++ char 'E' exp <- signedExp +++ lexInteger 10 - return (Just exp) + return (Just exp) where signedExp = do c <- char '-' +++ char '+'