Commit 747d99bc authored by Michael Hanus 's avatar Michael Hanus
Browse files

Style improvements, synched with PAKCS libs

parent 1aa56b6c
......@@ -85,10 +85,14 @@ toLower c | isUpper c = chr (ord c - ord 'A' + ord 'a')
--- Converts a (hexadecimal) digit character into an integer.
digitToInt :: Char -> Int
digitToInt c
| isDigit c = ord c - ord '0'
| ord c >= ord 'A' && ord c <= ord 'F' = ord c - ord 'A' + 10
| ord c >= ord 'a' && ord c <= ord 'f' = ord c - ord 'a' + 10
| otherwise = error "Char.digitToInt: argument is not a digit"
| isDigit c
= ord c - ord '0'
| ord c >= ord 'A' && ord c <= ord 'F'
= ord c - ord 'A' + 10
| ord c >= ord 'a' && ord c <= ord 'f'
= ord c - ord 'a' + 10
| otherwise
= error "Char.digitToInt: argument is not a digit"
--- Converts an integer into a (hexadecimal) digit character.
intToDigit :: Int -> Char
......
......@@ -6,13 +6,15 @@
--- @category general
------------------------------------------------------------------------------
module FileGoodies(separatorChar,pathSeparatorChar,suffixSeparatorChar,
isAbsolute,dirName,baseName,splitDirectoryBaseName,
stripSuffix,fileSuffix,splitBaseName,splitPath,
lookupFileInPath,getFileInPath) where
module FileGoodies
( separatorChar, pathSeparatorChar, suffixSeparatorChar
, isAbsolute, dirName, baseName, splitDirectoryBaseName
, stripSuffix, fileSuffix, splitBaseName, splitPath
, lookupFileInPath, getFileInPath
) where
import Directory
import List(intersperse)
import Directory ( doesFileExist )
import List ( intersperse )
--- The character for separating hierarchies in file names.
--- On UNIX systems the value is '/'.
......@@ -47,23 +49,25 @@ baseName name = snd (splitDirectoryBaseName name)
--- The directory prefix is "." if there is no real prefix in the name.
splitDirectoryBaseName :: String -> (String,String)
splitDirectoryBaseName name =
let (rbase,rdir) = break (==separatorChar) (reverse name) in
if null rdir then (".",reverse rbase)
let (rbase,rdir) = break (==separatorChar) (reverse name)
in if null rdir then (".",reverse rbase)
else (reverse (tail rdir), reverse rbase)
--- Strips a suffix (the last suffix starting with a dot) from a file name.
stripSuffix :: String -> String
stripSuffix = fst . splitBaseName
--- Yields the suffix (the last suffix starting with a dot) from given file name.
--- Yields the suffix (the last suffix starting with a dot)
--- from given file name.
fileSuffix :: String -> String
fileSuffix = snd . splitBaseName
--- Splits a file name into prefix and suffix (the last suffix starting with a dot
--- and the rest).
--- Splits a file name into prefix and suffix
--- (the last suffix starting with a dot and the rest).
splitBaseName :: String -> (String,String)
splitBaseName name = let (rsuffix,rbase) = break (==suffixSeparatorChar) (reverse name) in
if null rbase || elem separatorChar rsuffix
splitBaseName name =
let (rsuffix,rbase) = break (==suffixSeparatorChar) (reverse name)
in if null rbase || elem separatorChar rsuffix
then (name,"")
else (reverse (tail rbase),reverse rsuffix)
......
......@@ -44,8 +44,8 @@ module FilePath
-- * Extension methods
splitExtension,
takeExtension, replaceExtension, dropExtension, addExtension, hasExtension, (<.>),
splitExtensions, dropExtensions, takeExtensions,
takeExtension, replaceExtension, dropExtension, addExtension, hasExtension,
(<.>), splitExtensions, dropExtensions, takeExtensions, isExtensionOf,
-- * Drive methods
splitDrive, joinDrive,
......@@ -73,7 +73,7 @@ module FilePath
where
import Char (toLower, toUpper)
import List (isPrefixOf, init, last)
import List (isPrefixOf, isSuffixOf, init, last)
import Maybe (isJust, fromJust)
import System (getEnviron, isPosix, isWindows)
......@@ -275,6 +275,18 @@ dropExtensions = fst . splitExtensions
takeExtensions :: FilePath -> String
takeExtensions = snd . splitExtensions
-- | Does the given filename have the specified extension?
--
-- > "png" `isExtensionOf` "/directory/file.png" == True
-- > ".png" `isExtensionOf` "/directory/file.png" == True
-- > ".tar.gz" `isExtensionOf` "bar/foo.tar.gz" == True
-- > "ar.gz" `isExtensionOf` "bar/foo.tar.gz" == False
-- > "png" `isExtensionOf` "/directory/file.png.jpg" == False
-- > "csv/table.csv" `isExtensionOf` "/data/csv/table.csv" == False
isExtensionOf :: String -> FilePath -> Bool
isExtensionOf extension path = case extension of
ext@('.':_) -> isSuffixOf ext $ takeExtensions path
ext -> isSuffixOf ('.':ext) $ takeExtensions path
---------------------------------------------------------------------
-- Drive methods
......
......@@ -4,9 +4,10 @@
--- @category general
------------------------------------------------------------------------------
module Float(pi,(+.),(-.),(*.),(/.),(^.),i2f,truncate,round,recip,sqrt,log
,logBase, exp,sin,cos,tan,asin,acos,atan,sinh,cosh,tanh
,asinh,acosh,atanh) where
module Float
( pi, (+.), (-.), (*.), (/.), (^.), i2f, truncate, round, recip, sqrt, log
, logBase, exp, sin, cos, tan, asin, acos, atan, sinh, cosh, tanh
, asinh, acosh, atanh) where
-- The operator declarations are similar to the standard arithmetic operators.
......@@ -58,7 +59,8 @@ prim_Float_div external
a ^. b | b < 0 = 1 /. a ^. (b * (-1))
| otherwise = powaux 1.0 a b
where
powaux n x y = if y == 0 then n
powaux n x y = if y == 0
then n
else powaux (n *. if (y `mod` 2 == 1) then x else 1.0)
(x *. x)
(y `div` 2)
......
......@@ -25,9 +25,9 @@
------------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
module Global( Global, GlobalSpec(..), global
, readGlobal, safeReadGlobal, writeGlobal)
where
module Global
( Global, GlobalSpec(..), global
, readGlobal, safeReadGlobal, writeGlobal) where
----------------------------------------------------------------------
......
......@@ -98,7 +98,9 @@ external_d_C_global val (C_Persistent cname) _ _ =
where initGlobalFile name = do
ex <- doesFileExist name
if ex then return ()
else writeFile name (show val++"\n")
else do writeFile name (show val ++ "\n")
system ("chmod 600 " ++ name)
return ()
external_d_C_prim_readGlobal :: Curry_Prelude.Curry a => C_Global a -> Cover -> ConstStore
-> Curry_Prelude.C_IO a
......
......@@ -7,13 +7,14 @@
--- @category general
-----------------------------------------------------------------------------
module IO(Handle,IOMode(..),SeekMode(..),stdin,stdout,stderr,
openFile,hClose,hFlush,hIsEOF,isEOF,
hSeek,hWaitForInput,hWaitForInputs,
hWaitForInputOrMsg,hWaitForInputsOrMsg,hReady,
hGetChar,hGetLine,hGetContents,getContents,
hPutChar,hPutStr,hPutStrLn,hPrint,
hIsReadable,hIsWritable,hIsTerminalDevice) where
module IO
( Handle, IOMode(..), SeekMode(..), stdin, stdout, stderr
, openFile, hClose, hFlush, hIsEOF, isEOF
, hSeek, hWaitForInput, hWaitForInputs
, hWaitForInputOrMsg, hWaitForInputsOrMsg, hReady
, hGetChar, hGetLine, hGetContents, getContents
, hPutChar, hPutStr, hPutStrLn, hPrint
, hIsReadable, hIsWritable, hIsTerminalDevice ) where
--- The abstract type of a handle for a stream.
external data Handle -- internally defined
......@@ -101,8 +102,8 @@ prim_hWaitForInput external
--- Waits until input is available on some of the given handles.
--- If no input is available within t milliseconds, it returns -1,
--- otherwise it returns the index of the corresponding handle with the available
--- data.
--- otherwise it returns the index of the corresponding handle
-- with the available data.
--- @param handles - a list of handles for input streams
--- @param timeout - milliseconds to wait for input (< 0 : no time out)
--- @return -1 if no input is available within the time out, otherwise i
......@@ -115,7 +116,8 @@ prim_hWaitForInputs external
--- Waits until input is available on a given handles or a message
--- in the message stream. Usually, the message stream comes from an external port.
--- in the message stream.
--- Usually, the message stream comes from an external port.
--- Thus, this operation implements a committed choice over receiving input
--- from an IO handle or an external port.
---
......@@ -124,7 +126,8 @@ prim_hWaitForInputs external
--- of Sicstus-Prolog).</EM>
---
--- @param handle - a handle for an input stream
--- @param msgs - a stream of messages received via an external port (see Ports)
--- @param msgs - a stream of messages received via an external port
--- (see Ports)
--- @return (Left handle) if the handle has some data available
--- (Right msgs) if the stream msgs is instantiated
--- with at least one new message at the head
......@@ -135,7 +138,8 @@ hWaitForInputOrMsg handle msgs = do
return $ either (\_ -> Left handle) Right input
--- Waits until input is available on some of the given handles or a message
--- in the message stream. Usually, the message stream comes from an external port.
--- in the message stream.
--- Usually, the message stream comes from an external port.
--- Thus, this operation implements a committed choice over receiving input
--- from IO handles or an external port.
---
......@@ -144,7 +148,8 @@ hWaitForInputOrMsg handle msgs = do
--- of Sicstus-Prolog).</EM>
---
--- @param handles - a list of handles for input streams
--- @param msgs - a stream of messages received via an external port (see Ports)
--- @param msgs - a stream of messages received via an external port
--- (see Ports)
--- @return (Left i) if (handles!!i) has some data available
--- (Right msgs) if the stream msgs is instantiated
--- with at least one new message at the head
......
......@@ -23,8 +23,8 @@ import Char (isAlphaNum)
import Directory (removeFile)
import Read (readNat)
#endif
import IO
import System
import IO ( Handle, hClose, hGetChar, hIsEOF, hPutStrLn )
import System ( getPID, system )
--- Executes a command with a new default shell process.
--- The standard I/O streams of the new process (stdin,stdout,stderr)
......@@ -69,8 +69,8 @@ evalCmd cmd args input = do
-- do any quoting or escaping
| all goodChar str = str
| otherwise = '\'' : foldr escape "'" str
where escape c s
| c == '\'' = "'\\''" ++ s
where
escape c s | c == '\'' = "'\\''" ++ s
| otherwise = c : s
goodChar c = isAlphaNum c || c `elem` "-_.,/"
......
......@@ -8,10 +8,11 @@
--- @category general
------------------------------------------------------------------------------
module Integer((^), pow, ilog, isqrt, factorial, binomial,
max3, min3, maxlist, minlist,
bitTrunc, bitAnd, bitOr, bitNot, bitXor,
even, odd) where
module Integer
( (^), pow, ilog, isqrt, factorial, binomial
, max3, min3, maxlist, minlist
, bitTrunc, bitAnd, bitOr, bitNot, bitXor
, even, odd ) where
infixr 8 ^
......@@ -42,7 +43,8 @@ a ^ b = pow a b
pow :: Int -> Int -> Int
pow a b | b>= 0 = powaux 1 a b
where
powaux n x y = if y == 0 then n
powaux n x y = if y == 0
then n
else powaux (n * if (y `mod` 2 == 1) then x else 1)
(x * x)
(y `div` 2)
......@@ -68,12 +70,13 @@ ilog n | n>0 = if n<10 then 0 else 1 + ilog (n `div` 10)
--- @return the floor of the square root of `n`.
isqrt :: Int -> Int
isqrt n | n >= 0 =
if n == 0 then 0 else
if n < 4 then 1 else
aux 2 n
where aux low past = -- invariant low <= result < past
if past == low+1 then low
isqrt n | n >= 0 = if n == 0 then 0
else if n < 4 then 1
else aux 2 n
where
aux low past = -- invariant low <= result < past
if past == low+1
then low
else let cand = (past + low) `div` 2
in if cand*cand > n then aux low cand else aux cand past
......@@ -86,8 +89,7 @@ isqrt n | n >= 0 =
factorial :: Int -> Int
factorial n | n >= 0 = if n == 0 then 1 else n * factorial (n-1)
--- The value of `binomial n m` is
--- n*(n-1)*...*(n-m+1)/m*(m-1)*...1
--- The value of `binomial n m` is `n*(n-1)*...*(n-m+1)/m*(m-1)*...1`.
--- Fails if `m &lt;= 0` or `n &lt; m`.
---
--- @param n - Argument.
......@@ -155,7 +157,8 @@ bitTrunc n m = bitAnd (pow 2 n - 1) m
--- @return the bitwise and of `n` and `m`.
bitAnd :: Int -> Int -> Int
bitAnd n m = if m == 0 then 0
bitAnd n m = if m == 0
then 0
else let p = 2 * bitAnd (n `div` 2) (m `div` 2)
q = if m `mod` 2 == 0 then 0 else n `mod` 2
in p + q
......@@ -167,7 +170,8 @@ bitAnd n m = if m == 0 then 0
--- @return the bitwise inclusive or of `n` and `m`.
bitOr :: Int -> Int -> Int
bitOr n m = if m == 0 then n
bitOr n m = if m == 0
then n
else let p = 2 * bitOr (n `div` 2) (m `div` 2)
q = if m `mod` 2 == 1 then 1 else n `mod` 2
in p + q
......@@ -181,7 +185,9 @@ bitOr n m = if m == 0 then n
bitNot :: Int -> Int
bitNot n = aux 32 n
where aux c m = if c==0 then 0
where
aux c m = if c==0
then 0
else let p = 2 * aux (c-1) (m `div` 2)
q = 1 - m `mod` 2
in p + q
......@@ -193,7 +199,8 @@ bitNot n = aux 32 n
--- @return the bitwise exclusive of `n` and `m`.
bitXor :: Int -> Int -> Int
bitXor n m = if m == 0 then n
bitXor n m = if m == 0
then n
else let p = 2 * bitXor (n `div` 2) (m `div` 2)
q = if m `mod` 2 == n `mod` 2 then 0 else 1
in p + q
......
......@@ -36,7 +36,8 @@ elemIndex x = findIndex (x ==)
elemIndices :: Eq a => a -> [a] -> [Int]
elemIndices x = findIndices (x ==)
--- Returns the first element `e` of a list satisfying a predicate as `(Just e)`,
--- Returns the first element `e` of a list satisfying a predicate
--- as `(Just e)`,
--- otherwise `Nothing` is returned.
find :: (a -> Bool) -> [a] -> Maybe a
find p = listToMaybe . filter p
......@@ -157,7 +158,8 @@ permutations xs0 = xs0 : perms xs0 []
--- Example: `(partition (<4) [8,1,5,2,4,3]) = ([1,2,3],[8,5,4])`
partition :: (a -> Bool) -> [a] -> ([a],[a])
partition p xs = foldr select ([],[]) xs
where select x (ts,fs) = if p x then (x:ts,fs)
where
select x (ts,fs) = if p x then (x:ts,fs)
else (ts,x:fs)
--- Splits the list argument into a list of lists of equal adjacent
......@@ -184,7 +186,8 @@ splitOn :: Eq a => [a] -> [a] -> [[a]]
splitOn [] _ = error "splitOn called with an empty pattern"
splitOn [x] xs = split (x ==) xs
splitOn sep@(_:_:_) xs = go xs
where go [] = [[]]
where
go [] = [[]]
go l@(y:ys) | sep `isPrefixOf` l = [] : go (drop len l)
| otherwise = let (zs:zss) = go ys in (y:zs):zss
len = length sep
......@@ -289,7 +292,8 @@ maximum xs@(_:_) = foldl1 max xs
--- according to the given comparison function
maximumBy :: (a -> a -> Ordering) -> [a] -> a
maximumBy cmp xs@(_:_) = foldl1 maxBy xs
where maxBy x y = case cmp x y of
where
maxBy x y = case cmp x y of
GT -> x
_ -> y
......@@ -301,7 +305,8 @@ minimum xs@(_:_) = foldl1 min xs
--- according to the given comparison function
minimumBy :: (a -> a -> Ordering) -> [a] -> a
minimumBy cmp xs@(_:_) = foldl1 minBy xs
where minBy x y = case cmp x y of
where
minBy x y = case cmp x y of
GT -> y
_ -> x
......
----------------------------------------------------------------------------
--- The standard prelude of Curry (with type classes).
--- All top-level functions, data types, classes and methods defined
--- All exported functions, data types, classes, and methods defined
--- in this module are always available in any Curry program.
---
--- @category general
----------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
{-# OPTIONS_CYMAKE -Wno-incomplete-patterns -Wno-overlapping #-}
......@@ -24,9 +22,10 @@ module Prelude
, Success, Maybe (..), Either (..), IO (..), IOError (..)
, DET
-- functions
, (.), id, const, curry, uncurry, flip, until, seq, ensureNotFree
, ensureSpine, ($), ($!), ($!!), ($#), ($##), error
, failed, (&&), (||), not, otherwise, if_then_else, solve
, (.), id, const, curry, uncurry, flip, until
, seq, ensureNotFree, ensureSpine, ($), ($!), ($!!), ($#), ($##)
, error, failed
, (&&), (||), not, otherwise, if_then_else, solve
, fst, snd, head, tail, null, (++), length, (!!), map, foldl, foldl1
, foldr, foldr1, filter, zip, zip3, zipWith, zipWith3, unzip, unzip3
, concat, concatMap, iterate, repeat, replicate, take, drop, splitAt
......@@ -46,8 +45,9 @@ module Prelude
, Functor(..)
, sequence, sequence_, mapM, mapM_, foldM, liftM, liftM2, forM, forM_
, unlessM, whenM
, letrec
#ifdef __PAKCS__
, (=:<<=), letrec
, (=:<<=)
#endif
) where
......@@ -76,9 +76,12 @@ infixr 0 $, $!, $!!, $#, $##, `seq`, &, &>, ?
-- externally defined types for numbers and characters
external data Int
external data Float
external data Char
type String = [Char]
-- Some standard combinators:
......@@ -125,7 +128,8 @@ ensureNotFree external
--- Suspends until the result is bound to a non-variable spine.
ensureSpine :: [a] -> [a]
ensureSpine l = ensureList (ensureNotFree l)
where ensureList [] = []
where
ensureList [] = []
ensureList (x:xs) = x : ensureSpine xs
--- Right-associative application.
......@@ -450,7 +454,8 @@ replicate n x = take n (repeat x)
--- Returns prefix of length n.
take :: Int -> [a] -> [a]
take n l = if n<=0 then [] else takep n l
where takep _ [] = []
where
takep _ [] = []
takep m (x:xs) = x : take (m-1) xs
--- Returns suffix without first n elements.
......@@ -462,7 +467,8 @@ drop n xs = if n<=0 then xs
--- (splitAt n xs) is equivalent to (take n xs, drop n xs)
splitAt :: Int -> [a] -> ([a],[a])
splitAt n l = if n<=0 then ([],l) else splitAtp n l
where splitAtp _ [] = ([],[])
where
splitAtp _ [] = ([],[])
splitAtp m (x:xs) = let (ys,zs) = splitAt (m-1) xs in (x:ys,zs)
--- Returns longest prefix with elements satisfying a predicate.
......@@ -478,8 +484,7 @@ dropWhile p (x:xs) = if p x then dropWhile p xs else x:xs
--- (span p xs) is equivalent to (takeWhile p xs, dropWhile p xs)
span :: (a -> Bool) -> [a] -> ([a],[a])
span _ [] = ([],[])
span p (x:xs)
| p x = let (ys,zs) = span p xs in (x:ys, zs)
span p (x:xs) | p x = let (ys,zs) = span p xs in (x:ys, zs)
| otherwise = ([],x:xs)
--- (break p xs) is equivalent to (takeWhile (not.p) xs, dropWhile (not.p) xs).
......@@ -492,7 +497,8 @@ break p = span (not . p)
lines :: String -> [String]
lines [] = []
lines (x:xs) = let (l,xs_l) = splitline (x:xs) in l : lines xs_l
where splitline [] = ([],[])
where
splitline [] = ([],[])
splitline (c:cs) = if c=='\n'
then ([],cs)
else let (ds,es) = splitline cs in (c:ds,es)
......@@ -545,8 +551,7 @@ notElem x = all (x /=)
--- Looks up a key in an association list.
lookup :: Eq a => a -> [(a, b)] -> Maybe b
lookup _ [] = Nothing
lookup k ((x,y):xys)
| k==x = Just y
lookup k ((x,y):xys) | k==x = Just y
| otherwise = lookup k xys
--- Generates an infinite sequence of ascending integers.
......@@ -845,8 +850,8 @@ getLine = do c <- getChar
--- Each error contains a string shortly explaining the error.
--- This type might be extended in the future to distinguish
--- further error situations.
data IOError
= IOError String -- normal IO error
data IOError =
IOError String -- normal IO error
| UserError String -- user-specified error
| FailError String -- failing computation
| NondetError String -- non-deterministic computation
......@@ -1011,11 +1016,17 @@ apply external
cond :: Bool -> a -> a
cond external
#ifdef __PAKCS__
-- Only for internal use:
-- letrec ones (1:ones) -> bind ones to (1:ones)
--- This operation is internally used by PAKCS to implement recursive
--- `let`s by using cyclic term structures. Basically, the effect of
---
--- letrec ones (1:ones)
---
--- (where `ones` is a logic variable) is the binding of `ones` to `(1:ones)`.
letrec :: a -> a -> Bool
#ifdef __PAKCS__
letrec external
#else
letrec x y = let x = y in True -- not a real implementation
#endif
--- Non-strict equational constraint. Used to implement functional patterns.
......@@ -1024,8 +1035,8 @@ letrec external
#ifdef __PAKCS__
--- Non-strict equational constraint for linear functional patterns.
--- Thus, it must be ensured that the first argument is always (after evalutation
--- by narrowing) a linear pattern. Experimental.
--- Thus, it must be ensured that the first argument is always
--- (after evalutation by narrowing) a linear pattern. Experimental.
(=:<<=) :: a -> a -> Bool
(=:<<=) external
......@@ -1076,13 +1087,17 @@ instance (Eq a, Eq b, Eq c, Eq d) => Eq (a, b, c, d) where
(a, b, c, d) == (a', b', c', d') = a == a' && b == b' && c == c' && d == d'
instance (Eq a, Eq b, Eq c, Eq d, Eq e) => Eq (a, b, c, d, e) where
(a, b, c, d, e) == (a', b', c', d', e') = a == a' && b == b' && c == c' && d == d' && e == e'
(a, b, c, d, e) == (a', b', c', d', e') =
a == a' && b == b' && c == c' && d == d' && e == e'
instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f) => Eq (a, b, c, d, e, f) where
(a, b, c, d, e, f) == (a', b', c', d', e', f') = a == a' && b == b' && c == c' && d == d' && e == e' && f == f'
(a, b, c, d, e, f) == (a', b', c', d', e', f') =
a == a' && b == b' && c == c' && d == d' && e == e' && f == f'
instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g) => Eq (a, b, c, d, e, f, g) where
(a, b, c, d, e, f, g) == (a', b', c', d', e', f', g') = a == a' && b == b' && c == c' && d == d' && e == e' && f == f' && g == g'
instance (Eq a, Eq b, Eq c, Eq d, Eq e, Eq f, Eq g)
=> Eq (a, b, c, d, e, f, g) where
(a, b, c, d, e, f, g) == (a', b', c', d', e', f', g') =
a == a' && b == b' && c == c' && d == d' && e == e' && f == f' && g == g'
-- -------------------------------------------------------------------------
-- Ord class and related instances and functions
......@@ -1272,7 +1287,8 @@ class Read a where
readListDefault :: Read a => ReadS [a]
readListDefault = readParen False (\r -> [pr | ("[",s) <- lex r
, pr <- readl s])
where readl s = [([], t) | ("]", t) <- lex s] ++
where
readl s = [([], t) | ("]", t) <- lex s] ++
[(x : xs, u) | (x, t) <- reads s, (xs, u) <- readl' t]
readl' s = [([], t) | ("]", t) <- lex s] ++
[(x : xs, v) | (",", t) <- lex s, (x, u) <- reads t
......@@ -1418,7 +1434,8 @@ lex xs = case xs of
lexFracExp s = case s of
('.':c:cs)
| isDigit c ->
[('.' : ds ++ e, u) | (ds, t) <- lexDigits (c : cs), (e, u) <- lexExp t]
[('.' : ds ++ e, u) | (ds, t) <- lexDigits (c : cs),
(e, u) <- lexExp t]
_ -> lexExp s
lexExp s = case s of
(e:cs) | e `elem` "eE" ->
......@@ -1575,11 +1592,15 @@ instance (Bounded a, Bounded b, Bounded c) => Bounded (a, b, c) where
minBound = (minBound, minBound, minBound)
maxBound = (maxBound, maxBound, maxBound)
instance (Bounded a, Bounded b, Bounded c, Bounded d) => Bounded (a, b, c, d) where
instance (Bounded a, Bounded b, Bounded c, Bounded d)
=> Bounded (a, b, c, d)
where
minBound = (minBound, minBound, minBound, minBound)
maxBound = (maxBound, maxBound, maxBound, maxBound)
instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e) => Bounded (a, b, c, d, e) where
instance (Bounded a, Bounded b, Bounded c, Bounded d, Bounded e)
=> Bounded (a, b, c, d, e)
where
minBound = (minBound, minBound, minBound, minBound, minBound)
maxBound = (maxBound, maxBound, maxBound, maxBound, maxBound)
......@@ -1620,11 +1641,15 @@ instance Bounded Char where
instance Enum Char where
succ c | ord c < uppermostCharacter = chr $ ord c + 1
| otherwise = error "Prelude.Enum.Char.succ: no successor"
succ c | ord c < uppermostCharacter
= chr $ ord c + 1
| otherwise
= error "Prelude.Enum.Char.succ: no successor"
pred c | ord c > 0 = chr $ ord c - 1
| otherwise = error "Prelude.Enum.Char.succ: no predecessor"
pred c | ord c > 0
= chr $ ord c - 1
| otherwise
= error "Prelude.Enum.Char.succ: no predecessor"
toEnum = chr
fromEnum = ord
......
......@@ -10,9 +10,9 @@
--- @category general
------------------------------------------------------------------------------
module Read(readNat,readInt,readHex) where
module Read ( readNat, readInt, readHex ) where
import Char
import Char ( isDigit )
--- Read a natural number in a string.
--- The string might contain leadings blanks and the the number is read
......@@ -22,8 +22,8 @@ readNat l = readNatPrefix (dropWhile (\c->c==' ') l) 0
where
readNatPrefix [] n = n
readNatPrefix (c:cs) n =
let oc = ord c in
if oc>=ord '0' && oc<=ord '9' then readNatPrefix cs (n*10+oc-(ord '0'))
let oc = ord c
in if oc>=ord '0' && oc<=ord '9' then readNatPrefix cs (n*10+oc-(ord '0'))
else n
......@@ -45,8 +45,8 @@ readHex l = readHexPrefix (dropWhile (\c->c==' ') l) 0
where
readHexPrefix [] n = n
readHexPrefix (c:cs) n =
let cv = hex2int c in
if cv>=0 then readHexPrefix cs (n*16+cv)
let cv = hex2int c
in if cv>=0 then readHexPrefix cs (n*16+cv)
else n
hex2int c = if isDigit c then ord c - ord '0'
......
......@@ -32,7 +32,8 @@ readInt str = case dropWhile isSpace str of
--- otherwise the result is `Just (v, s)` where `v` is the value of the number
--- and s is the remaing string without the number token.
readNat :: String -> Maybe (Int, String)
readNat str = readNumPrefix (dropWhile isSpace str) Nothing 10 isDigit digitToInt
readNat str =
readNumPrefix (dropWhile isSpace str) Nothing 10 isDigit digitToInt