{-# LANGUAGE MonadComprehensions #-}
import Control.Monad.Writer
import Control.Monad.State
import Control.Applicative
import Data.Char
fib :: Integer -> Integer
fib 0 = 0
fib 1 = 1
fib n = fib (n-2) + fib (n-1)
fibm :: Monad m => Integer -> m Integer
fibm 0 = pure 0
fibm 1 = pure 1
fibm n = do
x <- fibm (n-2)
y <- fibm (n-1)
pure (x+y)
fib_maybe :: Integer -> Maybe Integer
fib_maybe = fibm
fib_list :: Integer -> [Integer]
fib_list = fibm
fib_list’ :: Integer -> [Integer]
fib_list’ 0 = pure 0 — equivalent to [0]
fib_list’ 1 = pure 1 — equivalent to [1]
fib_list’ n = [ x+y | x <- fib_list' (n-2), y <- fib_list' (n-1)]
fibm' :: Monad m => Integer -> m Integer
fibm’ 0 = pure 0
fibm’ 1 = pure 1
fibm’ n = [ x+y | x <- fibm' (n-2), y <- fibm' (n-1)]
fib1 :: Integer -> Maybe Integer
fib1 n | n < 0 = Nothing
| n == 0 = Just 0
| n == 1 = Just 1
| n >= 2 = case fib1 (n-2) of
Nothing -> Nothing
Just x -> case fib1 (n-1) of
Nothing -> Nothing
Just y -> Just (x+y)
fib1′ :: Integer -> Maybe Integer
fib1′ n | n < 0 = Nothing
| n == 0 = pure 0
| n == 1 = pure 1
| n >= 2 = do
x <- fib1' (n-2)
y <- fib1' (n-1)
pure (x+y)
fib2 :: Integer -> [Integer]
fib2 n | n < 0 = []
| n == 0 = pure 0
| n == 1 = pure 1
| n >= 2 = do
x <- fib2 (n-2)
y <- fib2 (n-1)
pure (x+y)
fib3 :: Integer -> IO Integer
fib3 n | n < 0 = error ("invalid input " ++ show n)
| n == 0 = pure 0
| n == 1 = pure 1
| n >= 2 = do
putStrLn (“call with n = ” ++ show n)
x <- fib3 (n-2)
y <- fib3 (n-1)
pure (x+y)
fibs :: [Integer]
fibs = 0 : 1 : zipWith (+) fibs (tail fibs)
fib4 :: Integer -> Writer [Integer] Integer
fib4 n | n < 0 = error ("invalid input " ++ show n)
| n == 0 = pure 0
| n == 1 = pure 1
| n >= 2 = do
tell [n]
x <- fib4 (n-2)
y <- fib4 (n-1)
pure (x+y)
fib5 :: Integer -> State Int Integer
fib5 n | n < 0 = error ("invalid input " ++ show n)
| n == 0 = pure 0
| n == 1 = pure 1
| n >= 2 = do
modify (+1)
x <- fib5 (n-2)
y <- fib5 (n-1)
pure (x+y)
fib' :: Integer -> Integer
fib’ n = x
where
f :: Integer -> State (Integer, Integer) ()
f 0 = pure ()
f n = do
modify (\(x,y) -> (y, x+y))
f (n-1)
((),(x,y)) = runState (f n) (0,1)
fibm” :: Monad m => Integer -> m Integer
fibm” 0 = pure 0
fibm” 1 = pure 1
fibm” n = fibm” (n-2) >>= (\x -> fibm” (n-1) >>= (\y -> pure (x+y)))
newtype Parser a = P (String -> [(a, String)])
parse :: Parser a -> String -> [(a, String)]
parse (P p) inp = p inp
item :: Parser Char
item = P (\inp -> case inp of
[] -> []
(x:xs) -> [(x,xs)])
instance Functor Parser where
— fmap :: (a -> b) -> Parser a -> Parser b
fmap g p = P (\inp -> case parse p inp of
[] -> []
[(v,out)] -> [(g v, out)])
instance Applicative Parser where
— pure :: a -> Parser a
pure v = P (\inp -> [(v,inp)])
— <*> :: Parser (a -> b) -> Parser a -> Parser b
pg <*> px = P (\inp -> case parse pg inp of
[] -> []
[(g, out)] -> parse (fmap g px) out)
instance Monad Parser where
— (>>=) :: Parser a -> (a -> Parser b) -> Parser b
p >>= f = P (\inp -> case parse p inp of
[] -> []
[(v,out)] -> parse (f v) out)
instance Alternative Parser where
— empty :: Parser a
empty = P (\inp -> [])
— (<|>) :: Parser a -> Parser a -> Parser a
p <|> q = P (\inp -> case parse p inp of
[] -> parse q inp
[(v,out)] -> [(v,out)])
sat :: (Char -> Bool) -> Parser Char
sat p = do x <- item
if p x then return x else empty
digit :: Parser Char
digit = sat isDigit
lower :: Parser Char
lower = sat isLower
upper :: Parser Char
upper = sat isUpper
letter :: Parser Char
letter = sat isAlpha
alphanum :: Parser Char
alphanum = sat isAlphaNum
char :: Char -> Parser Char
char x = sat (==x)
string :: String -> Parser String
string [] = return []
string (x:xs) = do char x
string xs
return (x:xs)
ident :: Parser String
ident = do x <- lower
xs <- many alphanum
return (x:xs)
nat :: Parser Int
nat = do xs <- some digit
return (read xs)
space :: Parser ()
space = do many (sat isSpace)
return ()
int :: Parser Int
int = do char '-'
n <- nat
return (-n)
<|> nat
token :: Parser a -> Parser a
token p = do space
v <- p
space
return v
identifier :: Parser String
identifier = token ident
natural :: Parser Int
natural = token nat
integer :: Parser Int
integer = token int
symbol :: String -> Parser String
symbol xs = token (string xs)
— a parser for a non-empty list of natural numbers that ignores spacing
nats :: Parser [Int]
nats = do symbol “[”
n <- natural
ns <- many (do symbol ","
natural)
symbol "]"
return (n:ns)
expr :: Parser Int
expr = do t <- term
do symbol "+"
e <- expr
return (t + e)
<|> return t
term :: Parser Int
term = do f <- factor
do symbol "*"
t <- term
return (f * t)
<|> return f
factor :: Parser Int
factor = do symbol “(”
e <- expr
symbol ")"
return e
<|> natural
eval :: String -> Int
eval xs = case parse expr xs of
[(n,[])] -> n
[(_,out)] -> error (“Unused input ” ++ out)
[] -> error “Invalid input”