diff --git a/Parsing.hs b/Parsing.hs new file mode 100644 index 0000000000000000000000000000000000000000..1974be1c4472a6b5f1f438730dc8b6a2c5221a32 --- /dev/null +++ b/Parsing.hs @@ -0,0 +1,122 @@ +-- 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) diff --git a/Testing.hs b/Testing.hs new file mode 100644 index 0000000000000000000000000000000000000000..312a5fdf1dfb8588d3ba157ea61c169b0474da02 --- /dev/null +++ b/Testing.hs @@ -0,0 +1,18 @@ +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))))) + + + diff --git a/Trial.hs b/Trial.hs new file mode 100644 index 0000000000000000000000000000000000000000..f68c78e58125d0c14748bb366739be5eb0725685 --- /dev/null +++ b/Trial.hs @@ -0,0 +1 @@ +foo (3) = (1,3) diff --git a/dist-newstyle/.DS_Store b/dist-newstyle/.DS_Store new file mode 100644 index 0000000000000000000000000000000000000000..d1ecf9a0221b8247c834ff742d1b05423e5fd3e2 Binary files /dev/null and b/dist-newstyle/.DS_Store differ diff --git a/dist-newstyle/cache/compiler b/dist-newstyle/cache/compiler new file mode 100644 index 0000000000000000000000000000000000000000..a7d2d8ca349bdbf0f66281c17b74ba99a23b9d56 Binary files /dev/null and b/dist-newstyle/cache/compiler differ