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

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
......
......@@ -107,8 +107,8 @@ prim_renameDirectory external
--- Returns the home directory of the current user.
getHomeDirectory :: IO FilePath
getHomeDirectory = if isWindows
then getEnviron "USERPROFILE"
else getEnviron "HOME"
then getEnviron "USERPROFILE"
else getEnviron "HOME"
--- Returns the temporary directory of the operating system.
getTemporaryDirectory :: IO FilePath
......@@ -124,7 +124,7 @@ getAbsolutePath path
return (normalise (homedir </> drop 2 path))
| otherwise = do curdir <- getCurrentDirectory
return (normalise (curdir </> path))
--- Deletes a file from the file system.
removeFile :: FilePath -> IO ()
removeFile file = prim_removeFile $## file
......
......@@ -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 '/'.
......@@ -32,7 +34,7 @@ suffixSeparatorChar = '.'
--- Is the argument an absolute name?
isAbsolute :: String -> Bool
isAbsolute (c:_) = c == separatorChar
isAbsolute [] = False
isAbsolute [] = False
--- Extracts the directoy prefix of a given (Unix) file name.
--- Returns "." if there is no prefix.
......@@ -47,52 +49,54 @@ 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)
else (reverse (tail rdir), 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
then (name,"")
else (reverse (tail rbase),reverse 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)
--- Splits a path string into list of directory names.
splitPath :: String -> [String]
splitPath [] = []
splitPath [] = []
splitPath (x:xs) = let (ys,zs) = break (==pathSeparatorChar) (x:xs)
in if null zs then [ys]
else ys : splitPath (tail zs)
in if null zs then [ys]
else ys : splitPath (tail zs)
--- Looks up the first file with a possible suffix in a list of directories.
--- Returns Nothing if such a file does not exist.
lookupFileInPath :: String -> [String] -> [String] -> IO (Maybe String)
lookupFileInPath file suffixes path =
if isAbsolute file
then lookupFirstFileWithSuffix file suffixes
else lookupFirstFile path
then lookupFirstFileWithSuffix file suffixes
else lookupFirstFile path
where
lookupFirstFile [] = return Nothing
lookupFirstFile (dir:dirs) = do
mbfile <- lookupFirstFileWithSuffix (dir++separatorChar:file) suffixes
maybe (lookupFirstFile dirs) (return . Just) mbfile
lookupFirstFileWithSuffix _ [] = return Nothing
lookupFirstFileWithSuffix f (suf:sufs) = do
let fsuf = f++suf
exfile <- doesFileExist fsuf
if exfile then return (Just fsuf)
else lookupFirstFileWithSuffix f sufs
lookupFirstFile [] = return Nothing
lookupFirstFile (dir:dirs) = do
mbfile <- lookupFirstFileWithSuffix (dir++separatorChar:file) suffixes
maybe (lookupFirstFile dirs) (return . Just) mbfile
lookupFirstFileWithSuffix _ [] = return Nothing
lookupFirstFileWithSuffix f (suf:sufs) = do
let fsuf = f++suf
exfile <- doesFileExist fsuf
if exfile then return (Just fsuf)
else lookupFirstFileWithSuffix f sufs
--- Gets the first file with a possible suffix in a list of directories.
--- An error message is delivered if there is no such file.
......
......@@ -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.
......@@ -57,8 +58,9 @@ prim_Float_div external
(^.) :: Float -> Int -> Float
a ^. b | b < 0 = 1 /. a ^. (b * (-1))
| otherwise = powaux 1.0 a b
where
powaux n x y = if y == 0 then n
where
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
......@@ -179,11 +184,11 @@ prim_hGetChar external
hGetLine :: Handle -> IO String
hGetLine h = do c <- hGetChar h
if c == '\n'
then return []
else do eof <- hIsEOF h
if eof then return [c]
else do cs <- hGetLine h
return (c:cs)
then return []
else do eof <- hIsEOF h
if eof then return [c]
else do cs <- hGetLine h
return (c:cs)
--- Reads the complete contents from an input handle and closes the input handle
......
......@@ -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,20 +69,20 @@ evalCmd cmd args input = do
-- do any quoting or escaping
| all goodChar str = str
| otherwise = '\'' : foldr escape "'" str
where escape c s
| c == '\'' = "'\\''" ++ s
| otherwise = c : s
goodChar c = isAlphaNum c || c `elem` "-_.,/"
where
escape c s | c == '\'' = "'\\''" ++ s
| otherwise = c : s
goodChar c = isAlphaNum c || c `elem` "-_.,/"
--- Reads from an input handle until EOF and returns the input.
hGetEOF :: Handle -> IO String
hGetEOF h = do
eof <- hIsEOF h
if eof
then hClose h >> return ""
else do c <- hGetChar h
cs <- hGetEOF h
return (c:cs)
then hClose h >> return ""
else do c <- hGetChar h
cs <- hGetEOF h
return (c:cs)
#else
evalCmd cmd args input = ((prim_evalCmd $## cmd) $## args) $## input
......@@ -118,8 +118,8 @@ readCompleteFile file = do
s <- readFile file
f s (return s)
where
f [] r = r
f (_:cs) r = f cs r
f [] r = r
f (_:cs) r = f cs r
--- An action that updates the contents of a file.
......
......@@ -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 ^
......@@ -41,8 +42,9 @@ 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
where
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,14 +70,15 @@ 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
else let cand = (past + low) `div` 2
in if cand*cand > n then aux low cand else aux cand past
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
--- The value of `factorial n` is the factorial of `n`.
--- Fails if `n &lt; 0`.
......@@ -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.
......@@ -125,7 +127,7 @@ min3 n m p = min n (min m p)
--- @return the maximum element of `l`.
maxlist :: Ord a => [a] -> a
maxlist [n] = n
maxlist [n] = n
maxlist (n:m:ns) = max n (maxlist (m:ns))
--- Returns the minimum of a list of integer values.
......@@ -135,7 +137,7 @@ maxlist (n:m:ns) = max n (maxlist (m:ns))
--- @return the minimum element of `l`.
minlist :: Ord a => [a] -> a
minlist [n] = n
minlist [n] = n
minlist (n:m:ns) = min n (minlist (m:ns))
--- The value of `bitTrunc n m` is the value of the `n`
......@@ -155,10 +157,11 @@ 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
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
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
--- Returns the bitwise inclusive OR of the two arguments.
---
......@@ -167,10 +170,11 @@ 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
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
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
--- Returns the bitwise NOT of the argument.
--- Since integers have unlimited precision,
......@@ -181,10 +185,12 @@ 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
else let p = 2 * aux (c-1) (m `div` 2)
q = 1 - m `mod` 2
in p + q
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
--- Returns the bitwise exclusive OR of the two arguments.
---
......@@ -193,10 +199,11 @@ 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
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
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
--- Returns whether an integer is even
---
......
......@@ -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
......@@ -142,13 +143,13 @@ diagonal = concat . foldr diags []
--- Returns the list of all permutations of the argument.
permutations :: [a] -> [[a]]
permutations xs0 = xs0 : perms xs0 []
where
where
perms [] _ = []
perms (t:ts) is = foldr interleave (perms ts (t:is)) (permutations is)
where interleave xs r = let (_, zs) = interleave' id xs r in zs
interleave' _ [] r = (ts, r)
interleave' f (y:ys) r = let (us, zs) = interleave' (f . (y:)) ys r
in (y:us, f (t:y:us) : zs)
in (y:us, f (t:y:us) : zs)
--- Partitions a list into a pair of lists where the first list
--- contains those elements that satisfy the predicate argument
......@@ -157,8 +158,9 @@ 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)
else (ts,x: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
--- elements.
......@@ -184,10 +186,11 @@ 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 [] = [[]]
go l@(y:ys) | sep `isPrefixOf` l = [] : go (drop len l)
| otherwise = let (zs:zss) = go ys in (y:zs):zss
len = length sep
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
--- Splits a list into components delimited by separators,
--- where the predicate returns True for a separator element.
......@@ -197,7 +200,7 @@ splitOn sep@(_:_:_) xs = go xs
--- > split (=='a') "aabbaca" == ["","","bb","c",""]
--- > split (=='a') "" == [""]
split :: (a -> Bool) -> [a] -> [[a]]
split _ [] = [[]]
split _ [] = [[]]
split p (x:xs) | p x = [] : split p xs
| otherwise = let (ys:yss) = split p xs in (x:ys):yss
......@@ -221,7 +224,7 @@ tails xxs@(_:xs) = xxs : tails xs
--- @param ys - the old list
--- @return the new list where the `p`. element is replaced by `x`
replace :: a -> Int -> [a] -> [a]
replace _ _ [] = []
replace _ _ [] = []
replace x p (y:ys) | p==0 = x:ys
| otherwise = y:(replace x (p-1) ys)
......@@ -230,8 +233,8 @@ replace x p (y:ys) | p==0 = x:ys
--- @param ys - a list
--- @return `True` if `xs` is a prefix of `ys`
isPrefixOf :: Eq a => [a] -> [a] -> Bool
isPrefixOf [] _ = True
isPrefixOf (_:_) [] = False
isPrefixOf [] _ = True
isPrefixOf (_:_) [] = False
isPrefixOf (x:xs) (y:ys) = x==y && (isPrefixOf xs ys)
--- Checks whether a list is a suffix of another.
......@@ -258,7 +261,7 @@ sortBy le = foldr (insertBy le) []
--- @param xs - a list
--- @return a list where the element has been inserted
insertBy :: (a -> a -> Bool) -> a -> [a] -> [a]
insertBy _ x [] = [x]
insertBy _ x [] = [x]
insertBy le x (y:ys) = if le x y
then x : y : ys
else y : insertBy le x ys
......@@ -289,9 +292,10 @@ 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
GT -> x
_ -> y
where
maxBy x y = case cmp x y of
GT -> x
_ -> y
--- Returns the minimum of a non-empty list.
minimum :: Ord a => [a] -> a
......@@ -301,17 +305,18 @@ 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
GT -> y
_ -> x
where
minBy x y = case cmp x y of
GT -> y
_ -> x
--- `scanl` is similar to `foldl`, but returns a list of successive
--- reduced values from the left:
--- scanl f z [x1, x2, ...] == [z, z `f` x1, (z `f` x1) `f` x2, ...]
scanl :: (a -> b -> a) -> a -> [b] -> [a]
scanl f q ls = q : (case ls of
[] -> []
x:xs -> scanl f (f q x) xs)
[] -> []
x:xs -> scanl f (f q x) xs)
--- `scanl1` is a variant of `scanl` that has no starting value argument:
--- scanl1 f [x1, x2, ...] == [x1, x1 `f` x2, ...]
......
......@@ -72,7 +72,7 @@ Just x >>- f = f x
--- Monadic `sequence` for `Maybe`.
sequenceMaybe :: [Maybe a] -> Maybe [a]
sequenceMaybe [] = Just []
sequenceMaybe [] = Just []
sequenceMaybe (c:cs) = c >>- \x -> sequenceMaybe cs >>- \xs -> Just (x:xs)
--- Monadic `map` for `Maybe`.
......
This diff is collapsed.
......@@ -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
......@@ -20,11 +20,11 @@ import Char
readNat :: String -> Int -- result >= 0
readNat l = readNatPrefix (dropWhile (\c->c==' ') l) 0
where
readNatPrefix [] n = n
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'))
else n
let oc = ord c
in if oc>=ord '0' && oc<=ord '9' then readNatPrefix cs (n*10+oc-(ord '0'))
else n
--- Read a (possibly negative) integer in a string.
......@@ -43,16 +43,16 @@ readInt l = readIntPrefix (dropWhile (\c->c==' ') l)
readHex :: String -> Int -- result >= 0
readHex l = readHexPrefix (dropWhile (\c->c==' ') l) 0
where
readHexPrefix [] n = n
readHexPrefix [] n = n
readHexPrefix (c:cs) n =
let cv = hex2int c in
if cv>=0 then readHexPrefix cs (n*16+cv)
else n
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'
else if ord c >= ord 'A' && ord c <= ord 'F'
then ord c - ord 'A' + 10
else -1
then ord c - ord 'A' + 10
else -1
-- end of library Read
......@@ -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
--- Read a hexadecimal number as a first token in a string.
--- The string might contain leadings blanks and the number is read
......@@ -42,7 +43,8 @@ readNat str = readNumPrefix (dropWhile isSpace str) Nothing 10 isDigit digitToIn
--- 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.
readHex :: String -> Maybe (Int, String)
readHex l = readNumPrefix (dropWhile isSpace l) Nothing 16 isHexDigit digitToInt
readHex l =
readNumPrefix (dropWhile isSpace l) Nothing 16 isHexDigit digitToInt
--- Read an octal number as a first token in a string.
--- The string might contain leadings blanks and the number is read
......@@ -52,7 +54,8 @@ readHex l = readNumPrefix (dropWhile isSpace l) Nothing 16 isHexDigit digitToInt
--- 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.
readOct :: String -> Maybe (Int, String)
readOct l = readNumPrefix (dropWhile isSpace l) Nothing 8 isOctDigit digitToInt
readOct l =
readNumPrefix (dropWhile isSpace l) Nothing 8 isOctDigit digitToInt
--- Read a binary number as a first token in a string.
--- The string might contain leadings blanks and the number is read
......@@ -62,7 +65,8 @@ readOct l = readNumPrefix (dropWhile isSpace l) Nothing 8 isOctDigit digitToInt
--- 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.
readBin :: String -> Maybe (Int, String)
readBin l = readNumPrefix (dropWhile isSpace l) Nothing 2 isBinDigit digitToInt