From 281425310c5db21f87981eeb9601a71d1974d98d Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Thu, 10 Apr 2014 05:25:03 +1000
Subject: Rearranging files

---
 src/Unlambda/Parser.hs | 125 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 125 insertions(+)
 create mode 100644 src/Unlambda/Parser.hs

(limited to 'src/Unlambda/Parser.hs')

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 ")
+
-- 
cgit