aboutsummaryrefslogtreecommitdiff
path: root/src/parser.hs
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/parser.hs
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/parser.hs')
-rw-r--r--src/parser.hs148
1 files changed, 0 insertions, 148 deletions
diff --git a/src/parser.hs b/src/parser.hs
deleted file mode 100644
index 405ff9b..0000000
--- a/src/parser.hs
+++ /dev/null
@@ -1,148 +0,0 @@
-module Parser 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
-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 = do first <- p
- rest first
- 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 '-'
- 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 = stringP opStr *> pure f
-
-parenthesize :: Parser a -> Parser a
-parenthesize p = charP '(' *> p <* charP ')'
-
-charP :: Char -> Parser Char
-charP c = satisfyChar (c ==)
-
-stringP :: String -> Parser String
-stringP s = sequenceA $ charP <$> s
-
-alphaP :: Parser Char
-alphaP = satisfyChar isAlpha
-
-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
- charP '.'
- 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