From d12ffc4f58768fd226930874edd98e4e4cd7c062 Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Tue, 16 Jul 2013 23:04:20 +0200 Subject: [PATCH 01/11] first commit --- y.hs | 114 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 114 insertions(+) create mode 100644 y.hs diff --git a/y.hs b/y.hs new file mode 100644 index 0000000..4343646 --- /dev/null +++ b/y.hs @@ -0,0 +1,114 @@ +module Main where + +import Data.List (foldl') +import Text.ParserCombinators.Parsec hiding (spaces) +import System.Environment (getArgs) + +data LispVal = Atom String + | List [LispVal] + | DottedList [LispVal] LispVal + | Number Integer + | String String + | Bool Bool + deriving (Show) + +symbol :: Parser Char +symbol = oneOf "!#$%&|*+-/:<=>?@^_~" + +spaces :: Parser () +spaces = skipMany1 space + +parseString :: Parser LispVal +parseString = do + char '"' + x <- many ( (char '\\' >> char 'n' >> return '\n') + <|> (char '\\' >> char 'r' >> return '\r') + <|> (char '\\' >> char 't' >> return '\t') + <|> (char '\\' >> anyChar) + <|> noneOf "\"" + ) + char '"' + return $ String x + +parseAtom :: Parser LispVal +parseAtom = do + first <- letter <|> symbol + rest <- many (letter <|> digit <|> symbol) + let atom = first:rest + return $ case atom of + "#vrai" -> Bool True + "#faux" -> Bool False + _ -> Atom atom + +numFromBase n str = foldl' traiteNombre 0 str + where + traiteNombre acc v = acc*n + chiffre + where chiffre = case v of + '0' -> 0 + '1' -> 1 + '2' -> 2 + '3' -> 3 + '4' -> 4 + '5' -> 5 + '6' -> 6 + '7' -> 7 + '8' -> 8 + '9' -> 9 + 'A' -> 10 + 'B' -> 11 + 'C' -> 12 + 'D' -> 13 + 'E' -> 14 + 'F' -> 15 + 'a' -> 10 + 'b' -> 11 + 'c' -> 12 + 'd' -> 13 + 'e' -> 14 + 'f' -> 15 + +parseBaseSpecifiedNumber :: Parser Integer +parseBaseSpecifiedNumber = do + _ <- char '#' + numtype <- oneOf "bdox" + (base,str) <- case numtype of + 'b' -> do + numstr <- many1 (oneOf "01") + return (2,numstr) + 'o' -> do + numstr <- many1 (oneOf "01234567") + return (8,numstr) + 'd' -> do + numstr <- many1 (oneOf "0123456789") + return (10,numstr) + 'x' -> do + numstr <- many1 (oneOf "0123456789ABCDEFabcdef") + return (16,numstr) + return $ numFromBase base str + +parseSimpleNumber :: Parser Integer +parseSimpleNumber = do + numStr <- many1 digit + return (read numStr) + +parseNumber :: Parser LispVal +parseNumber = do + number <- parseSimpleNumber + <|> parseBaseSpecifiedNumber + return (Number number) + +parseExpr :: Parser LispVal +parseExpr = parseString + <|> parseNumber + <|> parseAtom + + +readExpr :: String -> String +readExpr input = case parse parseExpr "lisp" input of + Left err -> "No match: " ++ show err + Right val -> show val + +main :: IO () +main = do + args <- getArgs + putStrLn (readExpr (args !!0)) From 7e377e2a32562166a11fc28aaf1ebd02ca5d966e Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Wed, 17 Jul 2013 22:25:48 +0200 Subject: [PATCH 02/11] adding test system --- test.sh | 17 +++++++++++++++++ tests/binarynumber.in | 1 + tests/binarynumber.out | 1 + tests/number.in | 1 + tests/number.out | 1 + tests/string-2.in | 1 + tests/string-2.out | 1 + tests/string-3.in | 1 + tests/string-3.out | 1 + tests/string.in | 1 + tests/string.out | 1 + 11 files changed, 27 insertions(+) create mode 100755 test.sh create mode 100644 tests/binarynumber.in create mode 100644 tests/binarynumber.out create mode 100644 tests/number.in create mode 100644 tests/number.out create mode 100644 tests/string-2.in create mode 100644 tests/string-2.out create mode 100644 tests/string-3.in create mode 100644 tests/string-3.out create mode 100644 tests/string.in create mode 100644 tests/string.out diff --git a/test.sh b/test.sh new file mode 100755 index 0000000..4b3fa0e --- /dev/null +++ b/test.sh @@ -0,0 +1,17 @@ +#!/usr/bin/env zsh + +for fic in tests/*.in; do + input="${fic:r}" + arg="$(cat $input.in)" + print -n -- "$input: " + runghc y.hs "$arg" > $input.res + if diff $input.res $input.out > /dev/null; then + print -- "OK" + else + print -- "ERROR" + print -- " expected: '$(cat $input.out)'" + print -- " got: '$(cat $input.res)'" + print -- "" + fi + \rm -f $input.res +done diff --git a/tests/binarynumber.in b/tests/binarynumber.in new file mode 100644 index 0000000..a3b9bf9 --- /dev/null +++ b/tests/binarynumber.in @@ -0,0 +1 @@ +#b001010 diff --git a/tests/binarynumber.out b/tests/binarynumber.out new file mode 100644 index 0000000..9f500df --- /dev/null +++ b/tests/binarynumber.out @@ -0,0 +1 @@ +Number 10 diff --git a/tests/number.in b/tests/number.in new file mode 100644 index 0000000..f5c8955 --- /dev/null +++ b/tests/number.in @@ -0,0 +1 @@ +32 diff --git a/tests/number.out b/tests/number.out new file mode 100644 index 0000000..64ed153 --- /dev/null +++ b/tests/number.out @@ -0,0 +1 @@ +Number 32 diff --git a/tests/string-2.in b/tests/string-2.in new file mode 100644 index 0000000..8d0a559 --- /dev/null +++ b/tests/string-2.in @@ -0,0 +1 @@ +"This is a string with a return ->\n<- Here" diff --git a/tests/string-2.out b/tests/string-2.out new file mode 100644 index 0000000..5a16424 --- /dev/null +++ b/tests/string-2.out @@ -0,0 +1 @@ +String "This is a string with a return ->\n<- Here" diff --git a/tests/string-3.in b/tests/string-3.in new file mode 100644 index 0000000..253907b --- /dev/null +++ b/tests/string-3.in @@ -0,0 +1 @@ +"This is a string with a tab ->\t<- Here" diff --git a/tests/string-3.out b/tests/string-3.out new file mode 100644 index 0000000..0c90516 --- /dev/null +++ b/tests/string-3.out @@ -0,0 +1 @@ +String "This is a string with a tab ->\t<- Here" diff --git a/tests/string.in b/tests/string.in new file mode 100644 index 0000000..4c0cf18 --- /dev/null +++ b/tests/string.in @@ -0,0 +1 @@ +"This is a simple string" diff --git a/tests/string.out b/tests/string.out new file mode 100644 index 0000000..1513617 --- /dev/null +++ b/tests/string.out @@ -0,0 +1 @@ +String "This is a simple string" From 8f3af55a4ee57f742699a4aae8e4be04a1153ce2 Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Wed, 17 Jul 2013 22:30:02 +0200 Subject: [PATCH 03/11] Exercises 3 --- y.hs | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/y.hs b/y.hs index 4343646..064d8d5 100644 --- a/y.hs +++ b/y.hs @@ -21,14 +21,17 @@ spaces = skipMany1 space parseString :: Parser LispVal parseString = do char '"' - x <- many ( (char '\\' >> char 'n' >> return '\n') - <|> (char '\\' >> char 'r' >> return '\r') - <|> (char '\\' >> char 't' >> return '\t') - <|> (char '\\' >> anyChar) - <|> noneOf "\"" - ) + x <- many $ strSpecialChar <|> noneOf "\"" char '"' return $ String x + where + strSpecialChar = char '\\' >> do + x <- anyChar + case x of + 'n' -> return '\n' + 't' -> return '\t' + 'r' -> return '\r' + _ -> return x parseAtom :: Parser LispVal parseAtom = do From 4ce9162f98c808446c5f5d0a163dbc0e5d7b94b7 Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Wed, 17 Jul 2013 22:30:34 +0200 Subject: [PATCH 04/11] better string test --- tests/string-3.in | 2 +- tests/string-3.out | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/string-3.in b/tests/string-3.in index 253907b..eb22e25 100644 --- a/tests/string-3.in +++ b/tests/string-3.in @@ -1 +1 @@ -"This is a string with a tab ->\t<- Here" +"More difficult string \n, \r, \t, \\, \x, \A" diff --git a/tests/string-3.out b/tests/string-3.out index 0c90516..5ee6306 100644 --- a/tests/string-3.out +++ b/tests/string-3.out @@ -1 +1 @@ -String "This is a string with a tab ->\t<- Here" +String "More difficult string \n, \r, \t, \\, x, A" From a5285e5ddb93b1a5a70246d6025fff6777f7ecdb Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Wed, 17 Jul 2013 22:45:03 +0200 Subject: [PATCH 05/11] Character ex. 5 --- tests/char.in | 1 + tests/char.out | 1 + y.hs | 8 ++++++++ 3 files changed, 10 insertions(+) create mode 100644 tests/char.in create mode 100644 tests/char.out diff --git a/tests/char.in b/tests/char.in new file mode 100644 index 0000000..e78f028 --- /dev/null +++ b/tests/char.in @@ -0,0 +1 @@ +#\a diff --git a/tests/char.out b/tests/char.out new file mode 100644 index 0000000..5915776 --- /dev/null +++ b/tests/char.out @@ -0,0 +1 @@ +Character 'a' diff --git a/y.hs b/y.hs index 064d8d5..75591bb 100644 --- a/y.hs +++ b/y.hs @@ -8,6 +8,7 @@ data LispVal = Atom String | List [LispVal] | DottedList [LispVal] LispVal | Number Integer + | Character Char | String String | Bool Bool deriving (Show) @@ -18,6 +19,12 @@ symbol = oneOf "!#$%&|*+-/:<=>?@^_~" spaces :: Parser () spaces = skipMany1 space +parseChar :: Parser LispVal +parseChar = do + string "#\\" + c <- anyChar + return $ Character c + parseString :: Parser LispVal parseString = do char '"' @@ -102,6 +109,7 @@ parseNumber = do parseExpr :: Parser LispVal parseExpr = parseString + <|> try parseChar <|> parseNumber <|> parseAtom From 9e59d4fc5304f937bfb2a81a77e5c1b778f468e4 Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Thu, 18 Jul 2013 10:14:26 +0200 Subject: [PATCH 06/11] partial exo 6 (Float) --- tests/float.in | 1 + tests/float.out | 1 + y.hs | 47 +++++++++++++++++++++++++++++++---------------- 3 files changed, 33 insertions(+), 16 deletions(-) create mode 100644 tests/float.in create mode 100644 tests/float.out diff --git a/tests/float.in b/tests/float.in new file mode 100644 index 0000000..6324d40 --- /dev/null +++ b/tests/float.in @@ -0,0 +1 @@ +3.14 diff --git a/tests/float.out b/tests/float.out new file mode 100644 index 0000000..c13b93f --- /dev/null +++ b/tests/float.out @@ -0,0 +1 @@ +Float 3.14 diff --git a/y.hs b/y.hs index 75591bb..bb4cbc4 100644 --- a/y.hs +++ b/y.hs @@ -4,15 +4,39 @@ import Data.List (foldl') import Text.ParserCombinators.Parsec hiding (spaces) import System.Environment (getArgs) +-- The possible LISP values data LispVal = Atom String | List [LispVal] | DottedList [LispVal] LispVal + | Float Float | Number Integer | Character Char | String String | Bool Bool deriving (Show) +-- The program (in IO) +-- execute the arguments given in parameters +main :: IO () +main = do + args <- getArgs + putStrLn (readExpr (args !!0)) + +-- ReadExpr will take a program as input +-- and will return the result of a parseExpr +readExpr :: String -> String +readExpr input = case parse parseExpr "lisp" input of + Left err -> "No match: " ++ show err + Right val -> show val + +-- parseExpr will parse the Expression +parseExpr :: Parser LispVal +parseExpr = parseString + <|> try parseChar -- #\a #\b etc... + <|> try parseFloat -- 3.1415 + <|> parseNumber -- 3, #b011001, #o070, #d930, #xFF3 + <|> parseAtom -- symbol-323 + symbol :: Parser Char symbol = oneOf "!#$%&|*+-/:<=>?@^_~" @@ -101,25 +125,16 @@ parseSimpleNumber = do numStr <- many1 digit return (read numStr) +parseFloat :: Parser LispVal +parseFloat = do + numBeforeDot <- many1 digit + char '.' + numAfterDot <- many1 digit + return $ Float (read (numBeforeDot ++ "." ++ numAfterDot)) + parseNumber :: Parser LispVal parseNumber = do number <- parseSimpleNumber <|> parseBaseSpecifiedNumber return (Number number) -parseExpr :: Parser LispVal -parseExpr = parseString - <|> try parseChar - <|> parseNumber - <|> parseAtom - - -readExpr :: String -> String -readExpr input = case parse parseExpr "lisp" input of - Left err -> "No match: " ++ show err - Right val -> show val - -main :: IO () -main = do - args <- getArgs - putStrLn (readExpr (args !!0)) From aa04fe2b3c93a464866234308cc06be86e63cd71 Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Thu, 18 Jul 2013 10:47:46 +0200 Subject: [PATCH 07/11] better testing method --- test.sh | 40 +++++++++++++++--------- tests/{binarynumber.out => binarynumber} | 1 + tests/binarynumber.in | 1 - tests/{char.out => char} | 1 + tests/char.in | 1 - tests/{float.out => float} | 1 + tests/float.in | 1 - tests/{number.out => number} | 1 + tests/number.in | 1 - tests/string | 6 ++++ tests/string-2.in | 1 - tests/string-2.out | 1 - tests/string-3.in | 1 - tests/string-3.out | 1 - tests/string.in | 1 - tests/string.out | 1 - y.hs | 23 ++++++++++++++ 17 files changed, 59 insertions(+), 24 deletions(-) rename tests/{binarynumber.out => binarynumber} (52%) delete mode 100644 tests/binarynumber.in rename tests/{char.out => char} (77%) delete mode 100644 tests/char.in rename tests/{float.out => float} (68%) delete mode 100644 tests/float.in rename tests/{number.out => number} (76%) delete mode 100644 tests/number.in create mode 100644 tests/string delete mode 100644 tests/string-2.in delete mode 100644 tests/string-2.out delete mode 100644 tests/string-3.in delete mode 100644 tests/string-3.out delete mode 100644 tests/string.in delete mode 100644 tests/string.out diff --git a/test.sh b/test.sh index 4b3fa0e..3a7a556 100755 --- a/test.sh +++ b/test.sh @@ -1,17 +1,29 @@ #!/usr/bin/env zsh -for fic in tests/*.in; do - input="${fic:r}" - arg="$(cat $input.in)" - print -n -- "$input: " - runghc y.hs "$arg" > $input.res - if diff $input.res $input.out > /dev/null; then - print -- "OK" - else - print -- "ERROR" - print -- " expected: '$(cat $input.out)'" - print -- " got: '$(cat $input.res)'" - print -- "" - fi - \rm -f $input.res +tmpfic=tests/tmp +for input in tests/*; do + sed 's/\\/\\\\/g' $input > $tmpfic + # set 3 as the file descriptor for the file $tmpfic + exec 3< $tmpfic + done=0 + num=1 + until ((done == 1)); do + read <&3 program + (($?!=0)) && {done=1;continue} + read <&3 expected + (($?!=0)) && {done=1;continue} + result="$( runghc y.hs "$program")" + printf "%18s (line %3d): " ${input:t} $num + if [[ $expected == $result ]]; then + print -- "OK" + else + print -- "ERROR" + print -- " program: '$program'" + print -- " expected: '$expected'" + print -- " got: '$result'" + print -- "" + fi + ((num+=2)) + done done +\rm -f $tmpfic diff --git a/tests/binarynumber.out b/tests/binarynumber similarity index 52% rename from tests/binarynumber.out rename to tests/binarynumber index 9f500df..a9ffca6 100644 --- a/tests/binarynumber.out +++ b/tests/binarynumber @@ -1 +1,2 @@ +#b001010 Number 10 diff --git a/tests/binarynumber.in b/tests/binarynumber.in deleted file mode 100644 index a3b9bf9..0000000 --- a/tests/binarynumber.in +++ /dev/null @@ -1 +0,0 @@ -#b001010 diff --git a/tests/char.out b/tests/char similarity index 77% rename from tests/char.out rename to tests/char index 5915776..56f7a70 100644 --- a/tests/char.out +++ b/tests/char @@ -1 +1,2 @@ +#\a Character 'a' diff --git a/tests/char.in b/tests/char.in deleted file mode 100644 index e78f028..0000000 --- a/tests/char.in +++ /dev/null @@ -1 +0,0 @@ -#\a diff --git a/tests/float.out b/tests/float similarity index 68% rename from tests/float.out rename to tests/float index c13b93f..25be416 100644 --- a/tests/float.out +++ b/tests/float @@ -1 +1,2 @@ +3.14 Float 3.14 diff --git a/tests/float.in b/tests/float.in deleted file mode 100644 index 6324d40..0000000 --- a/tests/float.in +++ /dev/null @@ -1 +0,0 @@ -3.14 diff --git a/tests/number.out b/tests/number similarity index 76% rename from tests/number.out rename to tests/number index 64ed153..5b34a3d 100644 --- a/tests/number.out +++ b/tests/number @@ -1 +1,2 @@ +32 Number 32 diff --git a/tests/number.in b/tests/number.in deleted file mode 100644 index f5c8955..0000000 --- a/tests/number.in +++ /dev/null @@ -1 +0,0 @@ -32 diff --git a/tests/string b/tests/string new file mode 100644 index 0000000..341906f --- /dev/null +++ b/tests/string @@ -0,0 +1,6 @@ +"This is a simple string" +String "This is a simple string" +"This is a string with a return ->\n<- Here" +String "This is a string with a return ->\n<- Here" +"More difficult string \n, \r, \t, \\, \x, \A" +String "More difficult string \n, \r, \t, \\, x, A" diff --git a/tests/string-2.in b/tests/string-2.in deleted file mode 100644 index 8d0a559..0000000 --- a/tests/string-2.in +++ /dev/null @@ -1 +0,0 @@ -"This is a string with a return ->\n<- Here" diff --git a/tests/string-2.out b/tests/string-2.out deleted file mode 100644 index 5a16424..0000000 --- a/tests/string-2.out +++ /dev/null @@ -1 +0,0 @@ -String "This is a string with a return ->\n<- Here" diff --git a/tests/string-3.in b/tests/string-3.in deleted file mode 100644 index eb22e25..0000000 --- a/tests/string-3.in +++ /dev/null @@ -1 +0,0 @@ -"More difficult string \n, \r, \t, \\, \x, \A" diff --git a/tests/string-3.out b/tests/string-3.out deleted file mode 100644 index 5ee6306..0000000 --- a/tests/string-3.out +++ /dev/null @@ -1 +0,0 @@ -String "More difficult string \n, \r, \t, \\, x, A" diff --git a/tests/string.in b/tests/string.in deleted file mode 100644 index 4c0cf18..0000000 --- a/tests/string.in +++ /dev/null @@ -1 +0,0 @@ -"This is a simple string" diff --git a/tests/string.out b/tests/string.out deleted file mode 100644 index 1513617..0000000 --- a/tests/string.out +++ /dev/null @@ -1 +0,0 @@ -String "This is a simple string" diff --git a/y.hs b/y.hs index bb4cbc4..5b98663 100644 --- a/y.hs +++ b/y.hs @@ -1,5 +1,6 @@ module Main where +import Control.Monad (liftM) import Data.List (foldl') import Text.ParserCombinators.Parsec hiding (spaces) import System.Environment (getArgs) @@ -36,6 +37,12 @@ parseExpr = parseString <|> try parseFloat -- 3.1415 <|> parseNumber -- 3, #b011001, #o070, #d930, #xFF3 <|> parseAtom -- symbol-323 + <|> parseQuoted + <|> do + char '(' + x <- try parseList <|> parseDottedList + char ')' + return x symbol :: Parser Char symbol = oneOf "!#$%&|*+-/:<=>?@^_~" @@ -138,3 +145,19 @@ parseNumber = do <|> parseBaseSpecifiedNumber return (Number number) +-- Recursive Parsers + +parseList :: Parser LispVal +parseList = liftM List $ sepBy parseExpr spaces + +parseDottedList :: Parser LispVal +parseDottedList = do + head <- endBy parseExpr spaces + tail <- char '.' >> spaces >> parseExpr + return $ DottedList head tail + +parseQuoted :: Parser LispVal +parseQuoted = do + char '\'' + x <- parseExpr + return $ List [Atom "quote", x] From 4326566ecd444f8db18c9431413d2d9ac8073f34 Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Thu, 18 Jul 2013 10:54:25 +0200 Subject: [PATCH 08/11] even better testing --- test.sh | 11 ++++++++++- tests/list | 4 ++++ 2 files changed, 14 insertions(+), 1 deletion(-) create mode 100644 tests/list diff --git a/test.sh b/test.sh index 3a7a556..e0b8eee 100755 --- a/test.sh +++ b/test.sh @@ -1,7 +1,16 @@ #!/usr/bin/env zsh +typeset -a listfic +if (($#==0)); then + listfic=( tests/*(.N) ) +else + for arg in $@; do + listfic=( $listfic tests/$arg ) + done +fi + tmpfic=tests/tmp -for input in tests/*; do +for input in $listfic; do sed 's/\\/\\\\/g' $input > $tmpfic # set 3 as the file descriptor for the file $tmpfic exec 3< $tmpfic diff --git a/tests/list b/tests/list new file mode 100644 index 0000000..03fd869 --- /dev/null +++ b/tests/list @@ -0,0 +1,4 @@ +(a list) +List [Atom "a",Atom "list"] +(a (nested) list) +List [Atom "a",List [Atom "nested"],Atom "list"] From 7b9efe9a3ee0e90b3e49487f3be1441d2cd0b73d Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Thu, 18 Jul 2013 18:55:18 +0200 Subject: [PATCH 09/11] better tests and results --- test.sh | 2 +- tests/binarynumber | 6 +++++- tests/char | 2 +- tests/float | 2 +- tests/list | 4 ---- tests/number | 2 +- tests/string | 10 +++++----- y.hs | 11 ++++++++++- 8 files changed, 24 insertions(+), 15 deletions(-) diff --git a/test.sh b/test.sh index e0b8eee..af56488 100755 --- a/test.sh +++ b/test.sh @@ -21,7 +21,7 @@ for input in $listfic; do (($?!=0)) && {done=1;continue} read <&3 expected (($?!=0)) && {done=1;continue} - result="$( runghc y.hs "$program")" + result="$(runghc y.hs "$program")" printf "%18s (line %3d): " ${input:t} $num if [[ $expected == $result ]]; then print -- "OK" diff --git a/tests/binarynumber b/tests/binarynumber index a9ffca6..17e13e6 100644 --- a/tests/binarynumber +++ b/tests/binarynumber @@ -1,2 +1,6 @@ +32 +32 +#x012 +18 #b001010 -Number 10 +10 diff --git a/tests/char b/tests/char index 56f7a70..eff905d 100644 --- a/tests/char +++ b/tests/char @@ -1,2 +1,2 @@ #\a -Character 'a' +'a' diff --git a/tests/float b/tests/float index 25be416..066db4f 100644 --- a/tests/float +++ b/tests/float @@ -1,2 +1,2 @@ 3.14 -Float 3.14 +3.14 diff --git a/tests/list b/tests/list index 03fd869..e69de29 100644 --- a/tests/list +++ b/tests/list @@ -1,4 +0,0 @@ -(a list) -List [Atom "a",Atom "list"] -(a (nested) list) -List [Atom "a",List [Atom "nested"],Atom "list"] diff --git a/tests/number b/tests/number index 5b34a3d..fc40ae5 100644 --- a/tests/number +++ b/tests/number @@ -1,2 +1,2 @@ 32 -Number 32 +32 diff --git a/tests/string b/tests/string index 341906f..a600a7d 100644 --- a/tests/string +++ b/tests/string @@ -1,6 +1,6 @@ "This is a simple string" -String "This is a simple string" -"This is a string with a return ->\n<- Here" -String "This is a string with a return ->\n<- Here" -"More difficult string \n, \r, \t, \\, \x, \A" -String "More difficult string \n, \r, \t, \\, x, A" +"This is a simple string" +"A tab ->\t<- Here" +"A tab -> <- Here" +"\S\o\m\e\ \pr\ot\e\ct\e\d\ \w\it\h\ \\" +"Some protected with \" diff --git a/y.hs b/y.hs index 5b98663..bcdaf11 100644 --- a/y.hs +++ b/y.hs @@ -28,7 +28,16 @@ main = do readExpr :: String -> String readExpr input = case parse parseExpr "lisp" input of Left err -> "No match: " ++ show err - Right val -> show val + Right val -> showVal val + +showVal :: LispVal -> String +showVal (String contents) = "\"" ++ contents ++ "\"" +showVal (Atom name) = name +showVal (Number contents) = show contents +showVal (Float contents) = show contents +showVal (Character c) = '\'':c:'\'':[] +showVal (Bool True) = "#t" +showVal (Bool False) = "#f" -- parseExpr will parse the Expression parseExpr :: Parser LispVal From 231275f473c11e10479346e5131e24d103925122 Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Thu, 18 Jul 2013 18:59:36 +0200 Subject: [PATCH 10/11] show value --- y.hs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/y.hs b/y.hs index bcdaf11..193fea8 100644 --- a/y.hs +++ b/y.hs @@ -14,7 +14,6 @@ data LispVal = Atom String | Character Char | String String | Bool Bool - deriving (Show) -- The program (in IO) -- execute the arguments given in parameters @@ -28,7 +27,7 @@ main = do readExpr :: String -> String readExpr input = case parse parseExpr "lisp" input of Left err -> "No match: " ++ show err - Right val -> showVal val + Right val -> show val showVal :: LispVal -> String showVal (String contents) = "\"" ++ contents ++ "\"" @@ -38,6 +37,13 @@ showVal (Float contents) = show contents showVal (Character c) = '\'':c:'\'':[] showVal (Bool True) = "#t" showVal (Bool False) = "#f" +showVal (List contents) = "(" ++ unwordsList contents ++ ")" +showVal (DottedList head tail) = "(" ++ unwordsList head ++ " . " ++ showVal tail ++ ")" + +unwordsList :: [LispVal] -> String +unwordsList = unwords . map showVal + +instance Show LispVal where show = showVal -- parseExpr will parse the Expression parseExpr :: Parser LispVal From 622dce0e578fb505cb1c357c13a657c697067731 Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Fri, 26 Jul 2013 16:45:50 +0200 Subject: [PATCH 11/11] added better eval --- y.hs | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/y.hs b/y.hs index 193fea8..17c0552 100644 --- a/y.hs +++ b/y.hs @@ -18,16 +18,14 @@ data LispVal = Atom String -- The program (in IO) -- execute the arguments given in parameters main :: IO () -main = do - args <- getArgs - putStrLn (readExpr (args !!0)) +main = getArgs >>= print . eval . readExpr . head -- ReadExpr will take a program as input -- and will return the result of a parseExpr -readExpr :: String -> String +readExpr :: String -> LispVal readExpr input = case parse parseExpr "lisp" input of - Left err -> "No match: " ++ show err - Right val -> show val + Left err -> String $ "No match: " ++ show err + Right val -> val showVal :: LispVal -> String showVal (String contents) = "\"" ++ contents ++ "\"" @@ -176,3 +174,12 @@ parseQuoted = do char '\'' x <- parseExpr return $ List [Atom "quote", x] + +-- Evaluation +eval :: LispVal -> LispVal +eval val@(Character _) = val +eval val@(String _) = val +eval val@(Number _) = val +eval val@(Float _) = val +eval val@(Bool _) = val +eval (List [Atom "quote", val]) = val