Commit c6b5b9d4 authored by Kai-Oliver Prott's avatar Kai-Oliver Prott
Browse files

Integrate other changes

parent 1a8926a5
module Control.Applicative
(Applicative(..), liftA, liftA3) where
( Applicative(..), liftA, liftA3, when
, sequenceA, sequenceA_
) where
--- Lift a function to actions.
--- This function may be used as a value for `fmap` in a `Functor` instance.
......@@ -9,3 +11,20 @@ liftA f a = pure f <*> a
--- Lift a ternary function to actions.
liftA3 :: Applicative f => (a -> b -> c -> d) -> f a -> f b -> f c -> f d
liftA3 f a b c = liftA2 f a b <*> c
-- | Conditional execution of 'Applicative' expressions.
when :: (Applicative f) => Bool -> f () -> f ()
when p s = if p then s else pure ()
--- Evaluate each action in the list from left to right, and
--- collect the results. For a version that ignores the results
--- see 'sequenceA_'.
sequenceA :: (Applicative f) => [f a] -> f [a]
sequenceA [] = pure []
sequenceA (x:xs) = (:) <$> x <*> sequenceA xs
--- Evaluate each action in the structure from left to right, and
--- ignore the results. For a version that doesn't ignore the results
--- see 'sequenceA'.
sequenceA_ :: (Applicative f) => [f a] -> f ()
sequenceA_ = foldr (*>) (pure ())
module Control.Monad
( Functor(..), Applicative(..), Monad(..)
, filterM, (>=>), (<=<), forever, mapAndUnzipM, zipWithM
, zipWithM_, foldM, foldM_, replicateM, replicateM_
, when, unless
) where
import Control.Applicative
--- This generalizes the list-based 'filter' function.
filterM :: (Applicative m) => (a -> m Bool) -> [a] -> m [a]
filterM p = foldr (\ x -> liftA2 (\ flg -> if flg
then (x:)
else id)
(p x))
(pure [])
infixr 1 <=<, >=>
--- Left-to-right composition of Kleisli arrows.
(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c)
f >=> g = \x -> f x >>= g
--- Right-to-left composition of Kleisli arrows. @('>=>')@, with the arguments
--- flipped.
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c)
(<=<) = flip (>=>)
--- Repeat an action indefinitely.
forever :: (Applicative f) => f a -> f b
forever a = let a' = a *> a' in a'
-- -----------------------------------------------------------------------------
-- Other monad functions
--- The 'mapAndUnzipM' function maps its first argument over a list, returning
--- the result as a pair of lists. This function is mainly used with complicated
--- data structures or a state-transforming monad.
mapAndUnzipM :: (Applicative m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
mapAndUnzipM f xs = unzip <$> sequenceA (map f xs)
--- The 'zipWithM' function generalizes 'zipWith' to
--- arbitrary applicative functors.
zipWithM :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM f xs ys = sequenceA (zipWith f xs ys)
--- 'zipWithM_' is the extension of 'zipWithM' which ignores the final result.
zipWithM_ :: (Applicative m) => (a -> b -> m c) -> [a] -> [b] -> m ()
zipWithM_ f xs ys = sequenceA_ (zipWith f xs ys)
--- The 'foldM' function is analogous to 'foldl', except that its result is
--- encapsulated in a monad.
foldM :: (Monad m) => (b -> a -> m b) -> b -> [a] -> m b
foldM f z0 xs = foldr f' return xs z0
where f' x k z = f z x >>= k
--- Like 'foldM', but discards the result.
foldM_ :: (Monad m) => (b -> a -> m b) -> b -> [a] -> m ()
foldM_ f a xs = foldM f a xs >> return ()
--- @'replicateM' n act@ performs the action @n@ times,
--- gathering the results.
replicateM :: (Applicative m) => Int -> m a -> m [a]
replicateM cnt0 f =
loop cnt0
where
loop cnt
| cnt <= 0 = pure []
| otherwise = liftA2 (:) f (loop (cnt - 1))
--- Like 'replicateM', but discards the result.
replicateM_ :: (Applicative m) => Int -> m a -> m ()
replicateM_ cnt0 f =
loop cnt0
where
loop cnt
| cnt <= 0 = pure ()
| otherwise = f *> loop (cnt - 1)
--- The reverse of 'when'.
unless :: (Applicative f) => Bool -> f () -> f ()
unless p s = if p then pure () else s
......@@ -11,6 +11,7 @@ module Data.Char
, isUpper, isLower, isAlpha, isDigit, isAlphaNum
, isBinDigit, isOctDigit, isHexDigit, isSpace
, toUpper, toLower, digitToInt, intToDigit
, ord, chr
) where
--- Returns true if the argument is an ASCII character.
......@@ -33,45 +34,6 @@ isAsciiUpper c = c >= 'A' && c <= 'Z'
isControl :: Char -> Bool
isControl c = c < '\x20' || c >= '\x7f' && c <= '\x9f'
--- Returns true if the argument is an uppercase letter.
isUpper :: Char -> Bool
isUpper c = c >= 'A' && c <= 'Z'
--- Returns true if the argument is an lowercase letter.
isLower :: Char -> Bool
isLower c = c >= 'a' && c <= 'z'
--- Returns true if the argument is a letter.
isAlpha :: Char -> Bool
isAlpha c = isUpper c || isLower c
--- Returns true if the argument is a decimal digit.
isDigit :: Char -> Bool
isDigit c = c >= '0' && c <= '9'
--- Returns true if the argument is a letter or digit.
isAlphaNum :: Char -> Bool
isAlphaNum c = isAlpha c || isDigit c
--- Returns true if the argument is a binary digit.
isBinDigit :: Char -> Bool
isBinDigit c = c >= '0' || c <= '1'
--- Returns true if the argument is an octal digit.
isOctDigit :: Char -> Bool
isOctDigit c = c >= '0' && c <= '7'
--- Returns true if the argument is a hexadecimal digit.
isHexDigit :: Char -> Bool
isHexDigit c = isDigit c || c >= 'A' && c <= 'F'
|| c >= 'a' && c <= 'f'
--- Returns true if the argument is a white space.
isSpace :: Char -> Bool
isSpace c = c == ' ' || c == '\t' || c == '\n' ||
c == '\r' || c == '\f' || c == '\v' ||
c == '\xa0' || ord c `elem` [5760,6158,8192,8239,8287,12288]
--- Converts lowercase into uppercase letters.
toUpper :: Char -> Char
toUpper c | isLower c = chr (ord c - ord 'a' + ord 'A')
......
......@@ -11,6 +11,7 @@ module Debug.Trace
, assert, assertIO
) where
import Control.Monad (unless)
import System.IO (hPutStrLn, stderr)
import System.IO.Unsafe (unsafePerformIO)
......
------------------------------------------------------------------------------
--- Library with some functions for reading and converting numeric tokens.
--
--- @author Michael Hanus, Frank Huch, Bjoern Peemoeller
--- @version November 2016
--- @category general
------------------------------------------------------------------------------
module Numeric
( readInt, readNat, readHex, readOct, readBin
) where
import Data.Char ( digitToInt, isBinDigit, isOctDigit
, isDigit, isHexDigit, isSpace)
import Data.Maybe
--- Read a (possibly negative) integer as a first token in a string.
--- The string might contain leadings blanks and the integer is read
--- up to the first non-digit.
--- On success returns `[(v,s)]`, where `v` is the value of the integer
--- and `s` is the remaing string without the integer token.
readInt :: ReadS Int
readInt str = case dropWhile isSpace str of
[] -> []
'-':str1 -> map (\(n,s) -> (-n, s)) (readNat str1)
str1 -> readNat str1
--- Read a natural number as a first token in a string.
--- The string might contain leadings blanks and the number is read
--- up to the first non-digit.
--- On success returns `[(v,s)]`, where `v` is the value of the number
--- and s is the remaing string without the number token.
readNat :: ReadS Int
readNat str = maybeToList $
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
--- up to the first non-hexadecimal digit.
--- On success returns `[(v,s)]`, where `v` is the value of the number
--- and s is the remaing string without the number token.
readHex :: ReadS Int
readHex l = maybeToList $
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
--- up to the first non-octal digit.
--- On success returns `[(v,s)]`, where `v` is the value of the number
--- and s is the remaing string without the number token.
readOct :: ReadS Int
readOct l = maybeToList $
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
--- up to the first non-binary digit.
--- On success returns `[(v,s)]`, where `v` is the value of the number
--- and s is the remaing string without the number token.
readBin :: ReadS Int
readBin l = maybeToList $
readNumPrefix (dropWhile isSpace l) Nothing 2 isBinDigit digitToInt
--- Read an integral number prefix where the value of an already read number
--- prefix is provided as the second argument.
--- The third argument is the base, the fourth argument
--- is a predicate to distinguish valid digits, and the fifth argument converts
--- valid digits into integer values.
readNumPrefix :: String -> Maybe Int -> Int -> (Char -> Bool) -> (Char -> Int)
-> Maybe (Int, String)
readNumPrefix [] Nothing _ _ _ = Nothing
readNumPrefix [] (Just n) _ _ _ = Just (n,"")
readNumPrefix (c:cs) (Just n) base isdigit valueof
| isdigit c = readNumPrefix cs (Just (base*n+valueof c)) base isdigit valueof
| otherwise = Just (n,c:cs)
readNumPrefix (c:cs) Nothing base isdigit valueof
| isdigit c = readNumPrefix cs (Just (valueof c)) base isdigit valueof
| otherwise = Nothing
......@@ -15,8 +15,7 @@ module Prelude
Char (..), Int (..), Float (..)
--++ , () (..), (,) (..), (,,) (..), (,,,) (..), (,,,,) (..)
--++ , [] (..), (->) (..)
, Bool (..), Ordering (..)
, Maybe (..)
, Bool (..), Ordering (..), Maybe (..), Either (..)
-- * Type Classes
, Eq (..) , Ord (..) , Show (..), shows, showChar, showString, showParen
......@@ -35,12 +34,12 @@ module Prelude
, isBinDigit, isOctDigit, isHexDigit, isSpace
, ord, chr
, String, lines, unlines, words, unwords
-- * Operations on Lists
, head, tail, null, (++), length, (!!), map, foldl, foldl1, foldr, foldr1
, filter, zip, zip3, zipWith, zipWith3, unzip, unzip3, concat, concatMap
, iterate, repeat, replicate, take, drop, splitAt, takeWhile, dropWhile
, span, break, reverse, and, or, any, all, elem, notElem, lookup
, span, break, reverse, and, or, any, all, elem, notElem, lookup, (<$>)
-- * Evaluation
, ($), ($!), ($!!), ($#), ($##), seq, ensureNotFree, ensureSpine
......@@ -48,11 +47,11 @@ module Prelude
-- * Other Functions
, (.), id, const, asTypeOf, curry, uncurry, flip, until
, (&&), (||), not, otherwise, ifThenElse, maybe, fst, snd
, (&&), (||), not, otherwise, ifThenElse, maybe, either, fst, snd
, failed, error
-- * IO-Type and Operations
, IO, done, getChar, getLine, putChar, putStr, putStrLn, print
, IO, getChar, getLine, putChar, putStr, putStrLn, print
, FilePath, readFile, writeFile, appendFile
, IOError (..), userError, ioError, catch
......@@ -1156,7 +1155,7 @@ instance Monoid Ordering where
EQ `mappend` y = y
GT `mappend` _ = GT
infixl 4 <$
infixl 4 <$, <$>
class Functor f where
fmap :: (a -> b) -> f a -> f b
......@@ -1170,6 +1169,9 @@ instance Functor [] where
instance Functor ((->) r) where
fmap = (.)
(<$>) :: Functor f => (a -> b) -> f a -> f b
(<$>) = fmap
infixl 4 <*>, <*, *>
class Functor f => Applicative f where
......@@ -1659,10 +1661,6 @@ lookup _ [] = Nothing
lookup k ((x,y):xys) | k == x = Just y
| otherwise = lookup k xys
-- -----------------------------------------------------------------------------
-- Base.Maybe
-- -----------------------------------------------------------------------------
data Maybe a = Nothing | Just a
deriving (Eq, Ord, Show, Read)
......@@ -1696,6 +1694,14 @@ maybe :: b -> (a -> b) -> Maybe a -> b
maybe n _ Nothing = n
maybe _ f (Just x) = f x
data Either a b = Left a
| Right b
deriving (Eq, Ord, Show, Read)
either :: (a -> c) -> (b -> c) -> Either a b -> c
either left _ (Left a) = left a
either _ right (Right b) = right b
external data IO _
instance Monoid a => Monoid (IO a) where
......@@ -1729,11 +1735,6 @@ seqIO external
returnIO :: a -> IO a
returnIO external
--- The empty IO action that returns nothing.
--TODO: remove
done :: IO ()
done = return ()
--- An action that reads a character from standard output and returns it.
getChar :: IO Char
getChar external
......@@ -1859,7 +1860,7 @@ solve True = True
--- Solves a constraint as an I/O action.
--- Note: The constraint should be always solvable in a deterministic way.
doSolve :: Bool -> IO ()
doSolve b | b = done
doSolve b | b = return ()
--- The equational constraint.
--- `(e1 =:= e2)` is satisfiable if both sides `e1` and `e2` can be
......
......@@ -129,11 +129,11 @@
<library>prim_standard</library>
<entry>prim_failure[raw]</entry>
</primitive>
<primitive name="&gt;&gt;=$" arity="2">
<primitive name="bindIO" arity="2">
<library>prim_standard</library>
<entry>prim_Monad_bind[raw]</entry>
</primitive>
<primitive name="&gt;&gt;$" arity="2">
<primitive name="seqIO" arity="2">
<library>prim_standard</library>
<entry>prim_Monad_seq[raw]</entry>
</primitive>
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment