Skip to content
Snippets Groups Projects
Commit e4d64b2c authored by kwsa1g20's avatar kwsa1g20
Browse files

rest

parent 5172e778
No related branches found
No related tags found
No related merge requests found
-- Functional parsing library from chapter 13 of Programming in Haskell,
-- Graham Hutton, Cambridge University Press, 2016.
module Parsing (module Parsing, module Control.Applicative) where
import Control.Applicative
import Data.Char
-- Basic definitions
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)])
-- Sequencing parsers
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)
-- Making choices
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)])
-- Derived primitives
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)
int :: Parser Int
int = do char '-'
n <- nat
return (-n)
<|> nat
-- Handling spacing
space :: Parser ()
space = do many (sat isSpace)
return ()
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)
import Challenges
challenge1Test1 = (calcBBInteractions (-8) [] [(North,1)]) == error "grid must be larger 0*0"
challenge1Test2 = (calcBBInteractions (8) [] [(North,1)]) == [((North,1),Path (South,1))] && (calcBBInteractions (8) [(2,3),(1,8)] []) == [] && calcBBInteractions 4 [(3,4)] [(North,2)] == [((North,2), Path (West,3))] && calcBBInteractions 4 [(1,1)] [(North,2)] == [((North,2),Reflect)] && calcBBInteractions 4 [(2,3)] [(North,2)] == [((North,2),Absorb)]
challenge3Tests = prettyPrint (LamVar 1) == "x1" && prettyPrint (LamAbs 1 (LamVar 1)) == "\\x0->x0" && prettyPrint (LamApp (LamAbs 2 (LamVar 5)) (LamVar 3)) == "(\\x0->x5)x3" && prettyPrint (LamAbs 1 ( LamAbs 2 (LamApp (LamAbs 1 (LamAbs 4 (LamVar 3))) (LamVar 3)))) == "\\x0->\\x0->(\\x0->\\x0->x3)x3"
challenge3Testserror = prettyPrint (LamAbs 2 (LamVar (-2))) == error " no negative variables"
challenge4Tests = parseArith "-2" == Nothing && parseArith "2+2" == Just (Add (ArithNum 2) (ArithNum 2)) && parseArith "2+2*3" == Just (Mul (Add (ArithNum 2) (ArithNum 2)) (ArithNum 3)) && parseArith "(+1)*2" == Nothing && parseArith "(+1)2*3" == Just (Mul(SecApp (Section (ArithNum 1)) (ArithNum 2)) (ArithNum 3))
challenge5Testerror = churchEnc (Add (ArithNum (-2)) (ArithNum 3)) == error " no negative numbers "
challenge5Test = churchEnc (ArithNum 4) == LamAbs 0 (LamAbs 1 (LamApp (LamVar 0) (LamApp (LamVar 0) (LamApp (LamVar 0) (LamApp (LamVar 0) (LamVar 1)))))) && churchEnc (Mul (ArithNum 3) (ArithNum 4)) == LamApp (LamApp (LamAbs 0 (LamAbs 1 (LamAbs 2 (LamAbs 3 (LamApp (LamApp (LamVar 0) (LamApp (LamVar 1) (LamVar 2))) (LamVar 3)))))) (LamAbs 0 (LamAbs 1 (LamApp (LamVar 0) (LamApp (LamVar 0) (LamApp (LamVar 0) (LamVar 1))))))) (LamAbs 0 (LamAbs 1 (LamApp (LamVar 0) (LamApp (LamVar 0) (LamApp (LamVar 0) (LamApp (LamVar 0) (LamVar 1)))))))
&& churchEnc (Add (ArithNum 2) (ArithNum 2)) == LamApp (LamApp (LamAbs 0 (LamAbs 1 (LamAbs 2 (LamAbs 3 (LamApp (LamApp (LamVar 0) (LamVar 2)) (LamApp (LamApp (LamVar 1) (LamVar 2)) (LamVar 3))))))) (LamAbs 0 (LamAbs 1 (LamApp (LamVar 0) (LamApp (LamVar 0) (LamVar 1)))))) (LamAbs 0 (LamAbs 1 (LamApp (LamVar 0) (LamApp (LamVar 0) (LamVar 1)))))
foo (3) = (1,3)
File added
File added
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment