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') ...@@ -85,10 +85,14 @@ toLower c | isUpper c = chr (ord c - ord 'A' + ord 'a')
--- Converts a (hexadecimal) digit character into an integer. --- Converts a (hexadecimal) digit character into an integer.
digitToInt :: Char -> Int digitToInt :: Char -> Int
digitToInt c digitToInt c
| isDigit c = ord c - ord '0' | isDigit c
| ord c >= ord 'A' && ord c <= ord 'F' = ord c - ord 'A' + 10 = 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'
| otherwise = error "Char.digitToInt: argument is not a digit" = 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. --- Converts an integer into a (hexadecimal) digit character.
intToDigit :: Int -> Char intToDigit :: Int -> Char
......
...@@ -107,8 +107,8 @@ prim_renameDirectory external ...@@ -107,8 +107,8 @@ prim_renameDirectory external
--- Returns the home directory of the current user. --- Returns the home directory of the current user.
getHomeDirectory :: IO FilePath getHomeDirectory :: IO FilePath
getHomeDirectory = if isWindows getHomeDirectory = if isWindows
then getEnviron "USERPROFILE" then getEnviron "USERPROFILE"
else getEnviron "HOME" else getEnviron "HOME"
--- Returns the temporary directory of the operating system. --- Returns the temporary directory of the operating system.
getTemporaryDirectory :: IO FilePath getTemporaryDirectory :: IO FilePath
...@@ -124,7 +124,7 @@ getAbsolutePath path ...@@ -124,7 +124,7 @@ getAbsolutePath path
return (normalise (homedir </> drop 2 path)) return (normalise (homedir </> drop 2 path))
| otherwise = do curdir <- getCurrentDirectory | otherwise = do curdir <- getCurrentDirectory
return (normalise (curdir </> path)) return (normalise (curdir </> path))
--- Deletes a file from the file system. --- Deletes a file from the file system.
removeFile :: FilePath -> IO () removeFile :: FilePath -> IO ()
removeFile file = prim_removeFile $## file removeFile file = prim_removeFile $## file
......
...@@ -6,13 +6,15 @@ ...@@ -6,13 +6,15 @@
--- @category general --- @category general
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
module FileGoodies(separatorChar,pathSeparatorChar,suffixSeparatorChar, module FileGoodies
isAbsolute,dirName,baseName,splitDirectoryBaseName, ( separatorChar, pathSeparatorChar, suffixSeparatorChar
stripSuffix,fileSuffix,splitBaseName,splitPath, , isAbsolute, dirName, baseName, splitDirectoryBaseName
lookupFileInPath,getFileInPath) where , stripSuffix, fileSuffix, splitBaseName, splitPath
, lookupFileInPath, getFileInPath
) where
import Directory import Directory ( doesFileExist )
import List(intersperse) import List ( intersperse )
--- The character for separating hierarchies in file names. --- The character for separating hierarchies in file names.
--- On UNIX systems the value is '/'. --- On UNIX systems the value is '/'.
...@@ -32,7 +34,7 @@ suffixSeparatorChar = '.' ...@@ -32,7 +34,7 @@ suffixSeparatorChar = '.'
--- Is the argument an absolute name? --- Is the argument an absolute name?
isAbsolute :: String -> Bool isAbsolute :: String -> Bool
isAbsolute (c:_) = c == separatorChar isAbsolute (c:_) = c == separatorChar
isAbsolute [] = False isAbsolute [] = False
--- Extracts the directoy prefix of a given (Unix) file name. --- Extracts the directoy prefix of a given (Unix) file name.
--- Returns "." if there is no prefix. --- Returns "." if there is no prefix.
...@@ -47,52 +49,54 @@ baseName name = snd (splitDirectoryBaseName name) ...@@ -47,52 +49,54 @@ baseName name = snd (splitDirectoryBaseName name)
--- The directory prefix is "." if there is no real prefix in the name. --- The directory prefix is "." if there is no real prefix in the name.
splitDirectoryBaseName :: String -> (String,String) splitDirectoryBaseName :: String -> (String,String)
splitDirectoryBaseName name = splitDirectoryBaseName name =
let (rbase,rdir) = break (==separatorChar) (reverse name) in let (rbase,rdir) = break (==separatorChar) (reverse name)
if null rdir then (".",reverse rbase) in if null rdir then (".",reverse rbase)
else (reverse (tail rdir), reverse rbase) else (reverse (tail rdir), reverse rbase)
--- Strips a suffix (the last suffix starting with a dot) from a file name. --- Strips a suffix (the last suffix starting with a dot) from a file name.
stripSuffix :: String -> String stripSuffix :: String -> String
stripSuffix = fst . splitBaseName 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 :: String -> String
fileSuffix = snd . splitBaseName fileSuffix = snd . splitBaseName
--- Splits a file name into prefix and suffix (the last suffix starting with a dot --- Splits a file name into prefix and suffix
--- and the rest). --- (the last suffix starting with a dot and the rest).
splitBaseName :: String -> (String,String) splitBaseName :: String -> (String,String)
splitBaseName name = let (rsuffix,rbase) = break (==suffixSeparatorChar) (reverse name) in splitBaseName name =
if null rbase || elem separatorChar rsuffix let (rsuffix,rbase) = break (==suffixSeparatorChar) (reverse name)
then (name,"") in if null rbase || elem separatorChar rsuffix
else (reverse (tail rbase),reverse rsuffix) then (name,"")
else (reverse (tail rbase),reverse rsuffix)
--- Splits a path string into list of directory names. --- Splits a path string into list of directory names.
splitPath :: String -> [String] splitPath :: String -> [String]
splitPath [] = [] splitPath [] = []
splitPath (x:xs) = let (ys,zs) = break (==pathSeparatorChar) (x:xs) splitPath (x:xs) = let (ys,zs) = break (==pathSeparatorChar) (x:xs)
in if null zs then [ys] in if null zs then [ys]
else ys : splitPath (tail zs) else ys : splitPath (tail zs)
--- Looks up the first file with a possible suffix in a list of directories. --- Looks up the first file with a possible suffix in a list of directories.
--- Returns Nothing if such a file does not exist. --- Returns Nothing if such a file does not exist.
lookupFileInPath :: String -> [String] -> [String] -> IO (Maybe String) lookupFileInPath :: String -> [String] -> [String] -> IO (Maybe String)
lookupFileInPath file suffixes path = lookupFileInPath file suffixes path =
if isAbsolute file if isAbsolute file
then lookupFirstFileWithSuffix file suffixes then lookupFirstFileWithSuffix file suffixes
else lookupFirstFile path else lookupFirstFile path
where where
lookupFirstFile [] = return Nothing lookupFirstFile [] = return Nothing
lookupFirstFile (dir:dirs) = do lookupFirstFile (dir:dirs) = do
mbfile <- lookupFirstFileWithSuffix (dir++separatorChar:file) suffixes mbfile <- lookupFirstFileWithSuffix (dir++separatorChar:file) suffixes
maybe (lookupFirstFile dirs) (return . Just) mbfile maybe (lookupFirstFile dirs) (return . Just) mbfile
lookupFirstFileWithSuffix _ [] = return Nothing lookupFirstFileWithSuffix _ [] = return Nothing
lookupFirstFileWithSuffix f (suf:sufs) = do lookupFirstFileWithSuffix f (suf:sufs) = do
let fsuf = f++suf let fsuf = f++suf
exfile <- doesFileExist fsuf exfile <- doesFileExist fsuf
if exfile then return (Just fsuf) if exfile then return (Just fsuf)
else lookupFirstFileWithSuffix f sufs else lookupFirstFileWithSuffix f sufs
--- Gets the first file with a possible suffix in a list of directories. --- Gets the first file with a possible suffix in a list of directories.
--- An error message is delivered if there is no such file. --- An error message is delivered if there is no such file.
......
...@@ -44,8 +44,8 @@ module FilePath ...@@ -44,8 +44,8 @@ module FilePath
-- * Extension methods -- * Extension methods
splitExtension, splitExtension,
takeExtension, replaceExtension, dropExtension, addExtension, hasExtension, (<.>), takeExtension, replaceExtension, dropExtension, addExtension, hasExtension,
splitExtensions, dropExtensions, takeExtensions, (<.>), splitExtensions, dropExtensions, takeExtensions, isExtensionOf,
-- * Drive methods -- * Drive methods
splitDrive, joinDrive, splitDrive, joinDrive,
...@@ -73,7 +73,7 @@ module FilePath ...@@ -73,7 +73,7 @@ module FilePath
where where
import Char (toLower, toUpper) import Char (toLower, toUpper)
import List (isPrefixOf, init, last) import List (isPrefixOf, isSuffixOf, init, last)
import Maybe (isJust, fromJust) import Maybe (isJust, fromJust)
import System (getEnviron, isPosix, isWindows) import System (getEnviron, isPosix, isWindows)
...@@ -275,6 +275,18 @@ dropExtensions = fst . splitExtensions ...@@ -275,6 +275,18 @@ dropExtensions = fst . splitExtensions
takeExtensions :: FilePath -> String takeExtensions :: FilePath -> String
takeExtensions = snd . splitExtensions 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 -- Drive methods
......
...@@ -4,9 +4,10 @@ ...@@ -4,9 +4,10 @@
--- @category general --- @category general
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
module Float(pi,(+.),(-.),(*.),(/.),(^.),i2f,truncate,round,recip,sqrt,log module Float
,logBase, exp,sin,cos,tan,asin,acos,atan,sinh,cosh,tanh ( pi, (+.), (-.), (*.), (/.), (^.), i2f, truncate, round, recip, sqrt, log
,asinh,acosh,atanh) where , 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. -- The operator declarations are similar to the standard arithmetic operators.
...@@ -57,8 +58,9 @@ prim_Float_div external ...@@ -57,8 +58,9 @@ prim_Float_div external
(^.) :: Float -> Int -> Float (^.) :: Float -> Int -> Float
a ^. b | b < 0 = 1 /. a ^. (b * (-1)) a ^. b | b < 0 = 1 /. a ^. (b * (-1))
| otherwise = powaux 1.0 a b | otherwise = powaux 1.0 a b
where 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) else powaux (n *. if (y `mod` 2 == 1) then x else 1.0)
(x *. x) (x *. x)
(y `div` 2) (y `div` 2)
......
...@@ -25,9 +25,9 @@ ...@@ -25,9 +25,9 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
module Global( Global, GlobalSpec(..), global module Global
, readGlobal, safeReadGlobal, writeGlobal) ( Global, GlobalSpec(..), global
where , readGlobal, safeReadGlobal, writeGlobal) where
---------------------------------------------------------------------- ----------------------------------------------------------------------
......
...@@ -98,7 +98,9 @@ external_d_C_global val (C_Persistent cname) _ _ = ...@@ -98,7 +98,9 @@ external_d_C_global val (C_Persistent cname) _ _ =
where initGlobalFile name = do where initGlobalFile name = do
ex <- doesFileExist name ex <- doesFileExist name
if ex then return () 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 external_d_C_prim_readGlobal :: Curry_Prelude.Curry a => C_Global a -> Cover -> ConstStore
-> Curry_Prelude.C_IO a -> Curry_Prelude.C_IO a
......
...@@ -7,13 +7,14 @@ ...@@ -7,13 +7,14 @@
--- @category general --- @category general
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module IO(Handle,IOMode(..),SeekMode(..),stdin,stdout,stderr, module IO
openFile,hClose,hFlush,hIsEOF,isEOF, ( Handle, IOMode(..), SeekMode(..), stdin, stdout, stderr
hSeek,hWaitForInput,hWaitForInputs, , openFile, hClose, hFlush, hIsEOF, isEOF
hWaitForInputOrMsg,hWaitForInputsOrMsg,hReady, , hSeek, hWaitForInput, hWaitForInputs
hGetChar,hGetLine,hGetContents,getContents, , hWaitForInputOrMsg, hWaitForInputsOrMsg, hReady
hPutChar,hPutStr,hPutStrLn,hPrint, , hGetChar, hGetLine, hGetContents, getContents
hIsReadable,hIsWritable,hIsTerminalDevice) where , hPutChar, hPutStr, hPutStrLn, hPrint
, hIsReadable, hIsWritable, hIsTerminalDevice ) where
--- The abstract type of a handle for a stream. --- The abstract type of a handle for a stream.
external data Handle -- internally defined external data Handle -- internally defined
...@@ -101,8 +102,8 @@ prim_hWaitForInput external ...@@ -101,8 +102,8 @@ prim_hWaitForInput external
--- Waits until input is available on some of the given handles. --- Waits until input is available on some of the given handles.
--- If no input is available within t milliseconds, it returns -1, --- If no input is available within t milliseconds, it returns -1,
--- otherwise it returns the index of the corresponding handle with the available --- otherwise it returns the index of the corresponding handle
--- data. -- with the available data.
--- @param handles - a list of handles for input streams --- @param handles - a list of handles for input streams
--- @param timeout - milliseconds to wait for input (< 0 : no time out) --- @param timeout - milliseconds to wait for input (< 0 : no time out)
--- @return -1 if no input is available within the time out, otherwise i --- @return -1 if no input is available within the time out, otherwise i
...@@ -115,7 +116,8 @@ prim_hWaitForInputs external ...@@ -115,7 +116,8 @@ prim_hWaitForInputs external
--- Waits until input is available on a given handles or a message --- 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 --- Thus, this operation implements a committed choice over receiving input
--- from an IO handle or an external port. --- from an IO handle or an external port.
--- ---
...@@ -124,7 +126,8 @@ prim_hWaitForInputs external ...@@ -124,7 +126,8 @@ prim_hWaitForInputs external
--- of Sicstus-Prolog).</EM> --- of Sicstus-Prolog).</EM>
--- ---
--- @param handle - a handle for an input stream --- @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 --- @return (Left handle) if the handle has some data available
--- (Right msgs) if the stream msgs is instantiated --- (Right msgs) if the stream msgs is instantiated
--- with at least one new message at the head --- with at least one new message at the head
...@@ -135,7 +138,8 @@ hWaitForInputOrMsg handle msgs = do ...@@ -135,7 +138,8 @@ hWaitForInputOrMsg handle msgs = do
return $ either (\_ -> Left handle) Right input return $ either (\_ -> Left handle) Right input
--- Waits until input is available on some of the given handles or a message --- 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 --- Thus, this operation implements a committed choice over receiving input
--- from IO handles or an external port. --- from IO handles or an external port.
--- ---
...@@ -144,7 +148,8 @@ hWaitForInputOrMsg handle msgs = do ...@@ -144,7 +148,8 @@ hWaitForInputOrMsg handle msgs = do
--- of Sicstus-Prolog).</EM> --- of Sicstus-Prolog).</EM>
--- ---
--- @param handles - a list of handles for input streams --- @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 --- @return (Left i) if (handles!!i) has some data available
--- (Right msgs) if the stream msgs is instantiated --- (Right msgs) if the stream msgs is instantiated
--- with at least one new message at the head --- with at least one new message at the head
...@@ -179,11 +184,11 @@ prim_hGetChar external ...@@ -179,11 +184,11 @@ prim_hGetChar external
hGetLine :: Handle -> IO String hGetLine :: Handle -> IO String
hGetLine h = do c <- hGetChar h hGetLine h = do c <- hGetChar h
if c == '\n' if c == '\n'
then return [] then return []
else do eof <- hIsEOF h else do eof <- hIsEOF h
if eof then return [c] if eof then return [c]
else do cs <- hGetLine h else do cs <- hGetLine h
return (c:cs) return (c:cs)
--- Reads the complete contents from an input handle and closes the input handle --- Reads the complete contents from an input handle and closes the input handle
......
...@@ -23,8 +23,8 @@ import Char (isAlphaNum) ...@@ -23,8 +23,8 @@ import Char (isAlphaNum)
import Directory (removeFile) import Directory (removeFile)
import Read (readNat) import Read (readNat)
#endif #endif
import IO import IO ( Handle, hClose, hGetChar, hIsEOF, hPutStrLn )
import System import System ( getPID, system )
--- Executes a command with a new default shell process. --- Executes a command with a new default shell process.
--- The standard I/O streams of the new process (stdin,stdout,stderr) --- The standard I/O streams of the new process (stdin,stdout,stderr)
...@@ -69,20 +69,20 @@ evalCmd cmd args input = do ...@@ -69,20 +69,20 @@ evalCmd cmd args input = do
-- do any quoting or escaping -- do any quoting or escaping
| all goodChar str = str | all goodChar str = str
| otherwise = '\'' : foldr escape "'" str | otherwise = '\'' : foldr escape "'" str
where escape c s where
| c == '\'' = "'\\''" ++ s escape c s | c == '\'' = "'\\''" ++ s
| otherwise = c : s | otherwise = c : s
goodChar c = isAlphaNum c || c `elem` "-_.,/" goodChar c = isAlphaNum c || c `elem` "-_.,/"
--- Reads from an input handle until EOF and returns the input. --- Reads from an input handle until EOF and returns the input.
hGetEOF :: Handle -> IO String hGetEOF :: Handle -> IO String
hGetEOF h = do hGetEOF h = do
eof <- hIsEOF h eof <- hIsEOF h
if eof if eof
then hClose h >> return "" then hClose h >> return ""
else do c <- hGetChar h else do c <- hGetChar h
cs <- hGetEOF h cs <- hGetEOF h
return (c:cs) return (c:cs)
#else #else
evalCmd cmd args input = ((prim_evalCmd $## cmd) $## args) $## input evalCmd cmd args input = ((prim_evalCmd $## cmd) $## args) $## input
...@@ -118,8 +118,8 @@ readCompleteFile file = do ...@@ -118,8 +118,8 @@ readCompleteFile file = do
s <- readFile file s <- readFile file
f s (return s) f s (return s)
where where
f [] r = r f [] r = r
f (_:cs) r = f cs r f (_:cs) r = f cs r
--- An action that updates the contents of a file. --- An action that updates the contents of a file.
......
...@@ -8,10 +8,11 @@ ...@@ -8,10 +8,11 @@
--- @category general --- @category general
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
module Integer((^), pow, ilog, isqrt, factorial, binomial, module Integer
max3, min3, maxlist, minlist, ( (^), pow, ilog, isqrt, factorial, binomial
bitTrunc, bitAnd, bitOr, bitNot, bitXor, , max3, min3, maxlist, minlist
even, odd) where , bitTrunc, bitAnd, bitOr, bitNot, bitXor
, even, odd ) where
infixr 8 ^ infixr 8 ^
...@@ -41,8 +42,9 @@ a ^ b = pow a b ...@@ -41,8 +42,9 @@ a ^ b = pow a b
pow :: Int -> Int -> Int pow :: Int -> Int -> Int
pow a b | b>= 0 = powaux 1 a b pow a b | b>= 0 = powaux 1 a b
where 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) else powaux (n * if (y `mod` 2 == 1) then x else 1)
(x * x) (x * x)
(y `div` 2) (y `div` 2)
...@@ -68,14 +70,15 @@ ilog n | n>0 = if n<10 then 0 else 1 + ilog (n `div` 10) ...@@ -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`. --- @return the floor of the square root of `n`.
isqrt :: Int -> Int isqrt :: Int -> Int
isqrt n | n >= 0 = isqrt n | n >= 0 = if n == 0 then 0
if n == 0 then 0 else else if n < 4 then 1
if n < 4 then 1 else else aux 2 n
aux 2 n where
where aux low past = -- invariant low <= result < past aux low past = -- invariant low <= result < past
if past == low+1 then low if past == low+1
else let cand = (past + low) `div` 2 then low
in if cand*cand > n then aux low cand else aux cand past 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`. --- The value of `factorial n` is the factorial of `n`.
--- Fails if `n &lt; 0`. --- Fails if `n &lt; 0`.
...@@ -86,8 +89,7 @@ isqrt n | n >= 0 = ...@@ -86,8 +89,7 @@ isqrt n | n >= 0 =
factorial :: Int -> Int factorial :: Int -> Int
factorial n | n >= 0 = if n == 0 then 1 else n * factorial (n-1) factorial n | n >= 0 = if n == 0 then 1 else n * factorial (n-1)
--- The value of `binomial n m` is --- The value of `binomial n m` is `n*(n-1)*...*(n-m+1)/m*(m-1)*...1`.
--- n*(n-1)*...*(n-m+1)/m*(m-1)*...1
--- Fails if `m &lt;= 0` or `n &lt; m`. --- Fails if `m &lt;= 0` or `n &lt; m`.
--- ---
--- @param n - Argument. --- @param n - Argument.
...@@ -125,7 +127,7 @@ min3 n m p = min n (min m p) ...@@ -125,7 +127,7 @@ min3 n m p = min n (min m p)
--- @return the maximum element of `l`. --- @return the maximum element of `l`.
maxlist :: Ord a => [a] -> a maxlist :: Ord a => [a] -> a
maxlist [n] = n maxlist [n] = n
maxlist (n:m:ns) = max n (maxlist (m:ns)) maxlist (n:m:ns) = max n (maxlist (m:ns))
--- Returns the minimum of a list of integer values. --- Returns the minimum of a list of integer values.
...@@ -135,7 +137,7 @@ maxlist (n:m:ns) = max n (maxlist (m:ns)) ...@@ -135,7 +137,7 @@ maxlist (n:m:ns) = max n (maxlist (m:ns))
--- @return the minimum element of `l`. --- @return the minimum element of `l`.
minlist :: Ord a => [a] -> a minlist :: Ord a => [a] -> a
minlist [n] = n minlist [n] = n
minlist (n:m:ns) = min n (minlist (m:ns)) minlist (n:m:ns) = min n (minlist (m:ns))
--- The value of `bitTrunc n m` is the value of the `n` --- 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 ...@@ -155,10 +157,11 @@ bitTrunc n m = bitAnd (pow 2 n - 1) m
--- @return the bitwise and of `n` and `m`. --- @return the bitwise and of `n` and `m`.
bitAnd :: Int -> Int -> Int bitAnd :: Int -> Int -> Int
bitAnd n m = if m == 0 then 0 bitAnd n m = if m == 0
else let p = 2 * bitAnd (n `div` 2) (m `div` 2) then 0
q = if m `mod` 2 == 0 then 0 else n `mod` 2 else let p = 2 * bitAnd (n `div` 2) (m `div` 2)
in p + q q = if m `mod` 2 == 0 then 0 else n `mod` 2
in p + q
--- Returns the bitwise inclusive OR of the two arguments. --- Returns the bitwise inclusive OR of the two arguments.
--- ---
...@@ -167,10 +170,11 @@ bitAnd n m = if m == 0 then 0 ...@@ -167,10 +170,11 @@ bitAnd n m = if m == 0 then 0
--- @return the bitwise inclusive or of `n` and `m`. --- @return the bitwise inclusive or of `n` and `m`.
bitOr :: Int -> Int -> Int bitOr :: Int -> Int -> Int
bitOr n m = if m == 0 then n bitOr n m = if m == 0
else let p = 2 * bitOr (n `div` 2) (m `div` 2) then n
q = if m `mod` 2 == 1 then 1 else n `mod` 2 else let p = 2 * bitOr (n `div` 2) (m `div` 2)
in p + q q = if m `mod` 2 == 1 then 1 else n `mod` 2
in p + q
--- Returns the bitwise NOT of the argument. --- Returns the bitwise NOT of the argument.
--- Since integers have unlimited precision, --- Since integers have unlimited precision,
...@@ -181,10 +185,12 @@ bitOr n m = if m == 0 then n ...@@ -181,10 +185,12 @@ bitOr n m = if m == 0 then n
bitNot :: Int -> Int bitNot :: Int -> Int
bitNot n = aux 32 n bitNot n = aux 32 n
where aux c m = if c==0 then 0 where
else let p = 2 * aux (c-1) (m `div` 2) aux c m = if c==0
q = 1 - m `mod` 2 then 0
in p + q 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. --- Returns the bitwise exclusive OR of the two arguments.
--- ---
...@@ -193,10 +199,11 @@ bitNot n = aux 32 n ...@@ -193,10 +199,11 @@ bitNot n = aux 32 n