aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorCharles <sircharlesaze@gmail.com>2020-03-16 12:09:27 +0100
committerCharles <sircharlesaze@gmail.com>2020-03-16 12:09:27 +0100
commitd17423cba7c15a26f835a6fa578ecb48b80d8aab (patch)
tree55b6ee4447ac61dcbc949acc5aa2436e014d2392 /src
parentd8751f2cced8f14366533ff0dbbc62fa73ec8665 (diff)
downloadcomputorv2-d17423cba7c15a26f835a6fa578ecb48b80d8aab.tar.gz
computorv2-d17423cba7c15a26f835a6fa578ecb48b80d8aab.tar.bz2
computorv2-d17423cba7c15a26f835a6fa578ecb48b80d8aab.zip
split parser in multiple modules, parsing of assignment and statement
Diffstat (limited to 'src')
-rw-r--r--src/assignment.hs11
-rw-r--r--src/expr.hs29
-rw-r--r--src/parser/assignment.hs15
-rw-r--r--src/parser/core.hs (renamed from src/parser.hs)58
-rw-r--r--src/parser/expr.hs45
-rw-r--r--src/parser/statement.hs12
-rw-r--r--src/statement.hs14
7 files changed, 127 insertions, 57 deletions
diff --git a/src/assignment.hs b/src/assignment.hs
new file mode 100644
index 0000000..c086280
--- /dev/null
+++ b/src/assignment.hs
@@ -0,0 +1,11 @@
+module Assignment where
+
+import qualified Expr as E
+
+data Assignment
+ = Variable String E.Expr
+ | Function String String E.Expr
+
+instance Show Assignment where
+ show (Variable name e) = name ++ " = " ++ show e
+ show (Function name arg e) = name ++ "(" ++ arg ++ ") = " ++ show e
diff --git a/src/expr.hs b/src/expr.hs
index 87a700b..e6f1f25 100644
--- a/src/expr.hs
+++ b/src/expr.hs
@@ -11,22 +11,25 @@ data Expr
| Div Expr Expr
| Mod Expr Expr
| Exp Expr Expr
- -- | Dot Expr Expr
+ | Variable String
+ | Function String Expr
+
eval :: Expr -> Maybe Atom
eval (EAtom a) = Just a
-eval (Add e1 e2) = evalBin e1 e2 (+?)
-eval (Sub e1 e2) = evalBin e1 e2 (-?)
-eval (Mul e1 e2) = evalBin e1 e2 (*?)
-eval (Div e1 e2) = evalBin e1 e2 (/?)
-eval (Mod e1 e2) = evalBin e1 e2 (%?)
-eval (Exp e1 e2) = evalBin e1 e2 (^?)
-
-evalBin :: Expr -> Expr -> (Atom -> Atom -> Maybe Atom) -> Maybe Atom
-evalBin e1 e2 f = do a <- eval e1
- b <- eval e2
- f a b
+eval (Add e1 e2) = evalInfix e1 e2 (+?)
+eval (Sub e1 e2) = evalInfix e1 e2 (-?)
+eval (Mul e1 e2) = evalInfix e1 e2 (*?)
+eval (Div e1 e2) = evalInfix e1 e2 (/?)
+eval (Mod e1 e2) = evalInfix e1 e2 (%?)
+eval (Exp e1 e2) = evalInfix e1 e2 (^?)
+eval _ = Nothing
+
+evalInfix :: Expr -> Expr -> (Atom -> Atom -> Maybe Atom) -> Maybe Atom
+evalInfix e1 e2 f = do a <- eval e1
+ b <- eval e2
+ f a b
instance Show Expr where
show (EAtom a) = show a
@@ -36,3 +39,5 @@ instance Show Expr where
show (Div e1 e2) = show e1 ++ " / " ++ show e2
show (Mod e1 e2) = show e1 ++ " % " ++ show e2
show (Exp e1 e2) = show e1 ++ " ^ " ++ show e2
+ show (Variable name) = name
+ show (Function name e) = name ++ "(" ++ show e ++ ")"
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.hs b/src/parser/core.hs
index 405ff9b..b622634 100644
--- a/src/parser.hs
+++ b/src/parser/core.hs
@@ -1,12 +1,9 @@
-module Parser where
+module Parser.Core where
import Control.Applicative
import Control.Monad
import Data.Char
-import Atom
-import Expr
-
newtype Parser a = Parser { parse :: String -> Maybe (a, String) }
parseStrict :: Parser a -> String -> Maybe a
@@ -62,15 +59,14 @@ 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 = do first <- p
- rest first
+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 charP '-'
+signed p = do char '-'
x <- p
return (-x)
<|> p
@@ -79,20 +75,23 @@ readParser :: Read a => Parser String -> Parser a
readParser p = read <$> p
infixOp :: String -> (a -> a -> a) -> Parser (a -> a -> a)
-infixOp opStr f = stringP opStr *> pure f
+infixOp opStr f = string opStr *> pure f
parenthesize :: Parser a -> Parser a
-parenthesize p = charP '(' *> p <* charP ')'
+parenthesize p = char '(' *> p <* char ')'
-charP :: Char -> Parser Char
-charP c = satisfyChar (c ==)
+char :: Char -> Parser Char
+char c = satisfyChar (c ==)
-stringP :: String -> Parser String
-stringP s = sequenceA $ charP <$> s
+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
@@ -108,41 +107,10 @@ intP = signed unsignedIntP
unsignedFloatP :: Parser Float
unsignedFloatP = readParser p
where p = do pos <- digitsP
- charP '.'
+ char '.'
dec <- digitsP
return (pos ++ "." ++ dec)
<|> digitsP
floatP :: Parser Float
floatP = signed unsignedFloatP
-
-imaginaryP :: Parser Atom
-imaginaryP = AImaginary <$> (floatP <* charP '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
-
-factorP :: Parser Expr
-factorP = endpointP `chainl1` expOpP
- where endpointP = parenthesisP <|> (EAtom <$> atomP)
-
-parenthesisP :: Parser Expr
-parenthesisP = parenthesize exprP
-
-atomP :: Parser Atom
-atomP = imaginaryP <|> rationalP
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 '?'
diff --git a/src/statement.hs b/src/statement.hs
new file mode 100644
index 0000000..75dfdb4
--- /dev/null
+++ b/src/statement.hs
@@ -0,0 +1,14 @@
+module Statement where
+
+import Assignment
+import Expr
+
+
+data Statement
+ = SAssignment Assignment
+ | SExpr Expr
+
+instance Show Statement where
+ show (SAssignment a) = show a
+ show (SExpr e) = show e
+