diff options
| author | Charles <sircharlesaze@gmail.com> | 2020-03-16 12:09:27 +0100 |
|---|---|---|
| committer | Charles <sircharlesaze@gmail.com> | 2020-03-16 12:09:27 +0100 |
| commit | d17423cba7c15a26f835a6fa578ecb48b80d8aab (patch) | |
| tree | 55b6ee4447ac61dcbc949acc5aa2436e014d2392 | |
| parent | d8751f2cced8f14366533ff0dbbc62fa73ec8665 (diff) | |
| download | computorv2-d17423cba7c15a26f835a6fa578ecb48b80d8aab.tar.gz computorv2-d17423cba7c15a26f835a6fa578ecb48b80d8aab.tar.bz2 computorv2-d17423cba7c15a26f835a6fa578ecb48b80d8aab.zip | |
split parser in multiple modules, parsing of assignment and statement
| -rw-r--r-- | src/assignment.hs | 11 | ||||
| -rw-r--r-- | src/expr.hs | 29 | ||||
| -rw-r--r-- | src/parser/assignment.hs | 15 | ||||
| -rw-r--r-- | src/parser/core.hs (renamed from src/parser.hs) | 58 | ||||
| -rw-r--r-- | src/parser/expr.hs | 45 | ||||
| -rw-r--r-- | src/parser/statement.hs | 12 | ||||
| -rw-r--r-- | src/statement.hs | 14 |
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 + |
