summaryrefslogtreecommitdiff
path: root/src/Unlambda/Parser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Unlambda/Parser.hs')
-rw-r--r--src/Unlambda/Parser.hs125
1 files changed, 125 insertions, 0 deletions
diff --git a/src/Unlambda/Parser.hs b/src/Unlambda/Parser.hs
new file mode 100644
index 0000000..23bf723
--- /dev/null
+++ b/src/Unlambda/Parser.hs
@@ -0,0 +1,125 @@
+module Unlambda.Parser (
+ parseUnlambda,
+ parseUnlambda1
+ ) where
+
+
+import Control.Applicative( some )
+import Data.Either
+import Text.ParserCombinators.Parsec
+import Unlambda.Types
+
+
+
+
+parseUnlambda :: String -> Either ParseError UnlambdaTerm
+parseUnlambda input =
+ let firstPass = parse removeComments "error" input
+ in case firstPass of
+ Left e -> Left e
+ Right o -> parse unlambda "error" o
+
+
+
+parseUnlambda1 :: String -> Either ParseError UnlambdaTerm
+parseUnlambda1 input =
+ let firstPass = parse removeComments "error" input
+ in case firstPass of
+ Left e -> Left e
+ Right o -> parse unlambda1 "error" o
+
+
+
+
+removeComments = uline `sepEndBy` eol >>= (return . concat)
+
+
+uline = do
+ l <- many (builtin <|> (oneOf " \t" >>= return . (:[])))
+ optional (char '#' >> many (noneOf "\r\n"))
+ return . concat $ l
+
+
+builtin = (oneOf "`skivrdce|@" >>= return . (:[]))
+ <|> (char '.' >> anyChar >>= return . ('.':) . (:[]))
+ <|> (char '?' >> anyChar >>= return . ('?':) . (:[]))
+ <?> "unlambda builtin function"
+
+
+eol = try (string "\r\n")
+ <|> try (string "\n\r")
+ <|> try (string "\r")
+ <|> try (string "\n")
+ <?> "end of line"
+
+
+unlambda = do
+ whiteSpace
+ t <- term
+ eof
+ return t
+
+
+unlambda1 = do
+ whiteSpace
+ t <- term1
+ eof
+ return t
+
+
+term = (try term1)
+ <|> (try e)
+ <|> (try reed)
+ <|> (try comp)
+ <|> (try bar)
+ <?> "unlambda term"
+
+
+term1 = (try app)
+ <|> (try s)
+ <|> (try k)
+ <|> (try i)
+ <|> (try v)
+ <|> (try r)
+ <|> (try d)
+ <|> (try c)
+ <|> (try dot)
+ <?> "unlambda term"
+
+
+app = do
+ char '`'
+ whiteSpace
+ f <- term
+ x <- term
+ return (App f x)
+
+
+s = char 's' >> whiteSpace >> return S
+k = char 'k' >> whiteSpace >> return K
+i = char 'i' >> whiteSpace >> return I
+v = char 'v' >> whiteSpace >> return V
+r = char 'r' >> whiteSpace >> return R
+d = char 'd' >> whiteSpace >> return D
+c = char 'c' >> whiteSpace >> return C
+e = char 'e' >> whiteSpace >> return E
+reed = char '@' >> whiteSpace >> return Reed
+bar = char '|' >> whiteSpace >> return Bar
+
+
+comp = do
+ char '?'
+ c <- anyChar
+ whiteSpace
+ return (Compare c)
+
+
+dot = do
+ char '.'
+ c <- anyChar
+ whiteSpace
+ return (Dot c)
+
+
+whiteSpace = many (oneOf "\t\n\r ")
+