diff --git a/crafting-interpreters-hs.cabal b/crafting-interpreters-hs.cabal index 2c11acf..c515836 100644 --- a/crafting-interpreters-hs.cabal +++ b/crafting-interpreters-hs.cabal @@ -54,7 +54,7 @@ common warnings ghc-options: -Wall library - exposed-modules: Lox.Scanner + exposed-modules: Lox.Scanner, Lox.Expr, Lox.Parser build-depends: base ^>=4.18.3.0, mtl, extra hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Lox/Expr.hs b/src/Lox/Expr.hs new file mode 100644 index 0000000..ea0d3d8 --- /dev/null +++ b/src/Lox/Expr.hs @@ -0,0 +1,12 @@ +module Lox.Expr ( + Expr (..) +) where + +import Lox.Scanner + +data Expr = + Literal Object | + Unary Token Expr | + Binary Expr Token Expr | + Grouping Expr + diff --git a/src/Lox/Parser.hs b/src/Lox/Parser.hs new file mode 100644 index 0000000..4f1269d --- /dev/null +++ b/src/Lox/Parser.hs @@ -0,0 +1,106 @@ +module Lox.Parser ( + expression +) where + +import Control.Monad +import Control.Monad.State +import Lox.Scanner +import Lox.Expr + +data ParserState = ParserState {tokens :: [Token]} + +-- expression → equality ; +-- equality → comparison ( ( "!=" | "==" ) comparison )* ; +-- comparison → term ( ( ">" | ">=" | "<" | "<=" ) term )* ; +-- term → factor ( ( "-" | "+" ) factor )* ; +-- factor → unary ( ( "/" | "*" ) unary )* ; +-- unary → ( "!" | "-" ) unary +-- | primary ; +-- primary → NUMBER | STRING | "true" | "false" | "nil" +-- | "(" expression ")" ; + +parse :: [Token] -> Expr +parse tokens = evalState expression (ParserState {tokens=tokens}) + +expression :: State ParserState Expr +expression = equality + +equality :: State ParserState Expr +equality = do + expr <- comparison + mergeExpressionMaybe expr <$> matchTail [BANG_EQUAL, EQUAL_EQUAL] comparison + +comparison :: State ParserState Expr +comparison = do + expr <- term + mergeExpressionMaybe expr <$> matchTail [GREATER, GREATER_EQUAL, LESS, LESS_EQUAL] term + +term :: State ParserState Expr +term = do + expr <- factor + mergeExpressionMaybe expr <$> matchTail [MINUS, PLUS] factor + +factor :: State ParserState Expr +factor = do + expr <- unary + mergeExpressionMaybe expr <$> matchTail [SLASH, STAR] unary + +unary :: State ParserState Expr +unary = do + maybeOperator <- matchToken [BANG, MINUS] + case maybeOperator of + Nothing -> primary + Just op -> Unary op <$> unary + +primary :: State ParserState Expr +primary = do + token <- advance + case getType token of + FALSE -> return $ Literal $ BoolObject False + TRUE -> return $ Literal $ BoolObject True + NIL -> return $ Literal NullObject + NUMBER -> return $ Literal $ getObject token + STRING -> return $ Literal $ getObject token + LEFT_PAREN -> do + expr <- expression + consume RIGHT_PAREN "Expected '(' after ')'" + return $ Grouping expr + _ -> error "Expected expression" + +matchTail :: [TokenType] -> State ParserState Expr -> State ParserState (Maybe (Token, Expr)) +matchTail tokenTypes f = do + maybeOperator <- matchToken tokenTypes + case maybeOperator of + Nothing -> return Nothing + Just op -> do + expr <- comparison + rest <- matchTail tokenTypes f + return $ Just (op, mergeExpressionMaybe expr rest) +mergeExpressionMaybe :: Expr -> Maybe (Token, Expr) -> Expr +mergeExpressionMaybe expr Nothing = expr +mergeExpressionMaybe left (Just (op, right)) = Binary left op right + +matchToken :: [TokenType] -> State ParserState (Maybe Token) +matchToken [] = return Nothing +matchToken (t:ts) = do + isMatch <- check t + if isMatch then Just <$> advance else matchToken ts + +check :: TokenType -> State ParserState Bool +check t = do + atEnd <- isAtEnd + if atEnd then return False else (== t) . getType <$> peek + +consume :: TokenType -> String -> State ParserState Token +consume t msg = do + isOk <- check t + if isOk then advance else error msg + +advance :: State ParserState Token +advance = state (\s@ParserState {tokens=(t:ts)} -> (t, s {tokens = ts})) + +peek :: State ParserState Token +peek = gets (head . tokens) + +isAtEnd :: State ParserState Bool +isAtEnd = (== EOF) . getType <$> peek diff --git a/src/Lox/Scanner.hs b/src/Lox/Scanner.hs index 303a191..58579a1 100644 --- a/src/Lox/Scanner.hs +++ b/src/Lox/Scanner.hs @@ -1,7 +1,7 @@ module Lox.Scanner ( - TokenType, - Object, - Token, + TokenType (..), + Object (..), + Token (getType, getLexeme, getObject), scanTokensFromSource ) where @@ -20,9 +20,9 @@ data TokenType = LEFT_PAREN | RIGHT_PAREN | LEFT_BRACE | RIGHT_BRACE | AND | CLASS | ELSE | FALSE | FUN | FOR | IF | NIL | OR | PRINT | RETURN | SUPER | THIS | TRUE | VAR | WHILE | EOF - deriving Show + deriving (Show, Eq) -data Object = NullObject | StringObject String | NumberObject Double deriving Show +data Object = NullObject | StringObject String | NumberObject Double | BoolObject Bool deriving Show data Token = Token { getType :: TokenType,