4 files changed, 188 insertions, 0 deletions
diff --git a/src/parser/assignment.hs b/src/parser/assignment.hs
new file mode 100644
index 0000000..bb782f5
--- /dev/null
+++ b/src/parser/assignment.hs
@@ -0,0 +1,15 @@
+module Parser.Assignment where
+
+import Control.Applicative
+import Parser.Core
+import qualified Parser.Expr as E
+import Assignment
+
+variableP :: Parser Assignment
+variableP = Variable <$> alphaStringP <* char '=' <*> E.exprP
+
+functionP :: Parser Assignment
+functionP = Function <$> alphaStringP <*> parenthesize alphaStringP <* char '=' <*> E.exprP
+
+assignmentP :: Parser Assignment
+assignmentP = variableP <|> functionP
diff --git a/src/parser/core.hs b/src/parser/core.hs
new file mode 100644
index 0000000..b622634
--- /dev/null
+++ b/src/parser/core.hs
@@ -0,0 +1,116 @@
+module Parser.Core where
+
+import Control.Applicative
+import Control.Monad
+import Data.Char
+
+newtype Parser a = Parser { parse :: String -> Maybe (a, String) }
+
+parseStrict :: Parser a -> String -> Maybe a
+parseStrict p input = case parse p input of Just (a, "") -> Just a
+                                            _            -> Nothing
+
+instance Functor Parser where
+    -- fmap :: (a -> b) -> Parser a -> Parser b
+    fmap f (Parser p) = Parser new_p
+        where new_p s = do
+                (x, s') <- p s
+                return (f x, s')
+
+instance Applicative Parser where
+    -- pure :: a -> Parser a
+    pure x = Parser (\s -> Just (x, s))
+    -- (<*>) :: Parser (a -> b) -> Parser a -> Parser b
+    (Parser p1) <*> (Parser p2) = Parser new_p
+        where new_p s = do
+                (f, s') <- p1 s
+                (x, s'') <- p2 s'
+                return (f x, s'')
+
+instance Alternative Parser where
+    -- empty :: Parser a
+    empty = Parser (\_ -> Nothing)
+    -- (<|>) :: Parser a -> Parser a -> Parser a
+    (Parser p1) <|> (Parser p2) = Parser new_p
+        where new_p s = p1 s <|> p2 s
+
+instance Monad Parser where
+    -- return :: a -> Parser a
+    return x = pure x
+    -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
+    (Parser p1) >>= f = Parser new_p
+        where new_p s = do
+                (x, s') <- p1 s
+                parse (f x) s'
+
+
+satisfyChar :: (Char -> Bool) -> Parser Char
+satisfyChar f = Parser p
+    where p []     = Nothing
+          p (c:cs) = if f c then Just (c, cs)
+                            else Nothing
+
+-- sepBy :: Parser b -> Parser a -> Parser [a]
+-- sepBy sep x = (:) <$> x <*> (many (sep *> x))
+-- sepByMap :: (b -> a -> a) -> Parser b -> Parser a -> Parser [a]
+-- sepByMap f sep x = (:) <$> x <*> (many (f <$> sep <*> x))
+
+chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
+chainl p op a = chainl1 p op <|> pure a
+
+chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
+chainl1 p op = p >>= rest
+    where rest prev = do f <- op
+                         e <- p
+                         rest (f prev e)
+                      <|> return prev
+
+signed :: Num a => Parser a -> Parser a
+signed p = do char '-'
+              x <- p
+              return (-x)
+           <|> p
+
+readParser :: Read a => Parser String -> Parser a
+readParser p = read <$> p
+
+infixOp :: String -> (a -> a -> a) -> Parser (a -> a -> a)
+infixOp opStr f = string opStr *> pure f
+
+parenthesize :: Parser a -> Parser a
+parenthesize p = char '(' *> p <* char ')'
+
+char :: Char -> Parser Char
+char c = satisfyChar (c ==)
+
+string :: String -> Parser String
+string s = sequenceA $ char <$> s
+
+alphaP :: Parser Char
+alphaP = satisfyChar isAlpha
+
+alphaStringP :: Parser String
+alphaStringP = some alphaP
+
+digitsP :: Parser String
+digitsP = some (satisfyChar isDigit) -- at least one digit to avoid read exception
+
+spacesP :: Parser String
+spacesP = many (satisfyChar isSpace)
+
+unsignedIntP :: Parser Int
+unsignedIntP = readParser digitsP
+
+intP :: Parser Int
+intP = signed unsignedIntP
+
+unsignedFloatP :: Parser Float
+unsignedFloatP = readParser p
+    where p = do pos <- digitsP
+                 char '.'
+                 dec <- digitsP
+                 return (pos ++ "." ++ dec)
+              <|> digitsP
+
+floatP :: Parser Float
+floatP = signed unsignedFloatP
diff --git a/src/parser/expr.hs b/src/parser/expr.hs
new file mode 100644
index 0000000..b84362d
--- /dev/null
+++ b/src/parser/expr.hs
@@ -0,0 +1,45 @@
+module Parser.Expr where
+
+import Control.Applicative
+
+import Parser.Core
+import Atom
+import Expr
+
+
+imaginaryP :: Parser Atom
+imaginaryP = AImaginary <$> (floatP <* char 'i')
+
+rationalP :: Parser Atom
+rationalP = ARational <$> floatP
+
+termOpP :: Parser (Expr -> Expr -> Expr)
+termOpP = infixOp "+" Add <|> infixOp "-" Sub
+
+factorOpP :: Parser (Expr -> Expr -> Expr)
+factorOpP = infixOp "*" Mul <|> infixOp "/" Div <|> infixOp "%" Mod
+
+expOpP :: Parser (Expr -> Expr -> Expr)
+expOpP = infixOp "^" Exp
+
+exprP :: Parser Expr
+exprP = termP `chainl1` termOpP
+
+termP :: Parser Expr
+termP =  factorP `chainl1` factorOpP
+
+variableP :: Parser Expr
+variableP = Variable <$> alphaStringP
+
+functionP :: Parser Expr
+functionP = Function <$> alphaStringP <*> parenthesisExprP
+
+factorP :: Parser Expr
+factorP =  endpointP `chainl1` expOpP
+    where endpointP = parenthesisExprP <|> (EAtom <$> atomP) <|> functionP <|> variableP
+
+parenthesisExprP :: Parser Expr
+parenthesisExprP = parenthesize exprP
+
+atomP :: Parser Atom
+atomP = imaginaryP <|> rationalP
diff --git a/src/parser/statement.hs b/src/parser/statement.hs
new file mode 100644
index 0000000..74f7f01
--- /dev/null
+++ b/src/parser/statement.hs
@@ -0,0 +1,12 @@
+module Parser.Statement where
+
+import Control.Applicative
+import Parser.Core
+import Parser.Expr
+import Parser.Assignment
+import Statement
+
+
+statementP :: Parser Statement
+statementP = SAssignment <$> assignmentP
+             <|> SExpr <$> exprP <* char '=' <* char '?'