104 lines
2.8 KiB
Haskell
104 lines
2.8 KiB
Haskell
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
|
{-# HLINT ignore "Use lambda-case" #-}
|
|
{-# HLINT ignore "Use tuple-section" #-}
|
|
module Parser where
|
|
|
|
import qualified Lexer as L
|
|
import Control.Applicative as Applicative
|
|
import Data.Void as Void
|
|
|
|
type CST = Expr
|
|
|
|
data Expr = Add Term Expr
|
|
| Sub Term Expr
|
|
| ETerm Term
|
|
deriving Show
|
|
|
|
data Term = Mult Factor Term
|
|
| Div Factor Term
|
|
| TFactor Factor
|
|
deriving Show
|
|
|
|
data Factor = Integer Int
|
|
| Parantheses Expr
|
|
| NegFactor Factor
|
|
deriving Show
|
|
|
|
type Tokens = [L.Token]
|
|
newtype Parser a = Parser {
|
|
runParser :: Tokens -> Maybe (Tokens, a)
|
|
}
|
|
|
|
instance Functor Parser where
|
|
fmap f (Parser p) = Parser $ \input -> case p input of
|
|
Nothing -> Nothing
|
|
Just (rest, a) -> Just (rest, f a)
|
|
|
|
instance Applicative Parser where
|
|
pure x = Parser $ \input -> Just (input, x)
|
|
(<*>) (Parser fParser) (Parser a) = Parser $ \input -> case fParser input of
|
|
Nothing -> Nothing
|
|
Just (rest, f) -> case a rest of
|
|
Nothing -> Nothing
|
|
Just (rest', x) -> Just (rest', f x)
|
|
|
|
instance Alternative Parser where
|
|
empty = Parser $ const Nothing
|
|
(<|>) (Parser p1) (Parser p2) = Parser $ \input -> case p1 input of
|
|
Nothing -> p2 input
|
|
result -> result
|
|
|
|
|
|
parse :: Tokens -> Maybe CST
|
|
parse tokens = case runParser parseExpression tokens of
|
|
Just ([], cst) -> Just cst
|
|
_ -> Nothing
|
|
|
|
|
|
parseAdd :: Parser Expr
|
|
parseAdd = liftA2 Add (parseTerm <* expect L.Plus) parseExpression
|
|
|
|
parseSub :: Parser Expr
|
|
parseSub = liftA2 Sub (parseTerm <* expect L.Hyphen) parseExpression
|
|
|
|
parseETerm :: Parser Expr
|
|
parseETerm = ETerm <$> parseTerm
|
|
|
|
parseExpression :: Parser Expr
|
|
parseExpression = parseAdd <|> parseSub <|> parseETerm
|
|
|
|
|
|
parseMult :: Parser Term
|
|
parseMult = liftA2 Mult (parseFactor <* expect L.Asterisk) parseTerm
|
|
|
|
parseDiv :: Parser Term
|
|
parseDiv = liftA2 Div (parseFactor <* expect L.ForwardSlash) parseTerm
|
|
|
|
parseTFactor :: Parser Term
|
|
parseTFactor = TFactor <$> parseFactor
|
|
|
|
parseTerm :: Parser Term
|
|
parseTerm = parseMult <|> parseDiv <|> parseTFactor
|
|
|
|
|
|
parseFactor :: Parser Factor
|
|
parseFactor = parseInt <|> parseParatheses <|> parseNegFactor
|
|
|
|
parseInt :: Parser Factor
|
|
parseInt = Parser $ \(token:rest) -> case token of
|
|
L.Integer i -> Just (rest, Integer i)
|
|
_ -> Nothing
|
|
|
|
parseNegFactor :: Parser Factor
|
|
parseNegFactor = NegFactor <$> (expect L.Hyphen *> parseFactor)
|
|
|
|
parseParatheses :: Parser Factor
|
|
parseParatheses = Parantheses <$> (expect L.LBrace *> parseExpression <* expect L.RBrace)
|
|
|
|
|
|
expect :: L.Token -> Parser (Maybe Void)
|
|
expect token = Parser $ \stream -> case stream of
|
|
(t:rest) -> if t == token
|
|
then Just (rest, Nothing)
|
|
else Nothing
|
|
_ -> Nothing
|