diff --git a/crafting-interpreters-hs.cabal b/crafting-interpreters-hs.cabal index 260e578..9c148c7 100644 --- a/crafting-interpreters-hs.cabal +++ b/crafting-interpreters-hs.cabal @@ -54,8 +54,8 @@ common warnings ghc-options: -Wall library - exposed-modules: Lox.Scanner, Lox.Expr, Lox.Parser, Lox.Interpreter - build-depends: base ^>=4.18.3.0, mtl, extra + exposed-modules: Lox.Scanner, Lox.Expr, Lox.Parser, Lox.Interpreter, Lox.Environment + build-depends: base ^>=4.18.3.0, mtl, extra, containers hs-source-dirs: src default-language: Haskell2010 diff --git a/src/Lox/Environment.hs b/src/Lox/Environment.hs new file mode 100644 index 0000000..cd1c35e --- /dev/null +++ b/src/Lox/Environment.hs @@ -0,0 +1,25 @@ +module Lox.Environment ( + Environment, + emptyEnvironment, + define, + get, + assign +) where + +import Data.Map +import Lox.Scanner + +data Environment = Environment {variables :: Map String Object} + +emptyEnvironment :: Environment +emptyEnvironment = Environment {variables=empty} + +define :: String -> Object -> Environment -> Environment +define key value env@Environment {variables=variables} = env {variables=insert key value variables} + +get :: String -> Environment -> Maybe Object +get key Environment {variables=variables} = variables !? key + +assign :: String -> Object -> Environment -> (Bool, Environment) +assign key value env@Environment {variables=variables} = + if member key variables then (True, env {variables=insert key value variables}) else (False, env) diff --git a/src/Lox/Expr.hs b/src/Lox/Expr.hs index e181e66..4e89fe1 100644 --- a/src/Lox/Expr.hs +++ b/src/Lox/Expr.hs @@ -6,13 +6,16 @@ module Lox.Expr ( import Lox.Scanner data Stmt = - Expression Expr | - Print Expr + ExpressionStmt Expr | + PrintStmt Expr | + VariableStmt Token Expr deriving Show data Expr = - Literal Object | - Unary Token Expr | - Binary Expr Token Expr | - Grouping Expr + LiteralExpr Object | + UnaryExpr Token Expr | + BinaryExpr Expr Token Expr | + GroupingExpr Expr | + VariableExpr Token | + AssignmentExpr Token Expr deriving Show diff --git a/src/Lox/Interpreter.hs b/src/Lox/Interpreter.hs index 598f8ed..25ce85a 100644 --- a/src/Lox/Interpreter.hs +++ b/src/Lox/Interpreter.hs @@ -5,34 +5,49 @@ module Lox.Interpreter ( import Lox.Expr import Lox.Scanner +import Lox.Environment import Control.Monad.State import Control.Monad -data InterpreterState = InterpreterState (IO ()) +data InterpreterState = InterpreterState {io :: IO (), environment :: Environment} emptyInterpreter :: InterpreterState -emptyInterpreter = InterpreterState (return ()) +emptyInterpreter = InterpreterState {io=return (), environment=emptyEnvironment} runStatements :: [Stmt] -> IO () runStatements s = io - where InterpreterState io = execState (interpret s) emptyInterpreter + where InterpreterState {io=io} = execState (interpret s) emptyInterpreter interpret :: [Stmt] -> State InterpreterState () interpret = foldr ((>>) . execute) (return ()) execute :: Stmt -> State InterpreterState () -execute (Print expr) = do +execute (PrintStmt expr) = do value <- evalFrom expr - modify (\(InterpreterState s) -> InterpreterState (s >> print value)) -execute (Expression value) = void $ evalFrom value + modify (\s@(InterpreterState {io=io}) -> s {io=io >> print value}) +execute (ExpressionStmt value) = void $ evalFrom value +execute (VariableStmt name expr) = do + value <- evalFrom expr + modify (\s@(InterpreterState {environment=env}) -> s {environment=define (tokenLexeme name) value env}) eval :: Expr -> IO Object -eval expr = return $ evalState (evalFrom expr) $ InterpreterState (return ()) +eval expr = return $ evalState (evalFrom expr) emptyInterpreter evalFrom :: Expr -> State InterpreterState Object -evalFrom (Literal value) = return value -evalFrom (Grouping expr) = evalFrom expr -evalFrom (Unary op expr) = do +evalFrom (LiteralExpr value) = return value +evalFrom (VariableExpr name) = do + maybeObject <- gets (\(InterpreterState {environment=env}) -> Lox.Environment.get (tokenLexeme name) env) + case maybeObject of + Nothing -> error "Undefined variable" + Just object -> return object +evalFrom (AssignmentExpr name expr) = do + value <- evalFrom expr + success <- state $ f value + if success then return value else error "Undefined variable" + where f value s@InterpreterState {environment=env} = let (success, newEnv) = assign (tokenLexeme name) value env in (success, s {environment=newEnv}) + +evalFrom (GroupingExpr expr) = evalFrom expr +evalFrom (UnaryExpr op expr) = do right <- evalFrom expr case (tokenType op, right) of (MINUS, NumberObject x) -> return $ NumberObject (-x) @@ -40,7 +55,7 @@ evalFrom (Unary op expr) = do (BANG, BoolObject x) -> return $ BoolObject (not x) (BANG, _) -> return $ BoolObject True _ -> error "Type error" -evalFrom (Binary leftExpr op rightExpr) = do +evalFrom (BinaryExpr leftExpr op rightExpr) = do left <- evalFrom leftExpr right <- evalFrom rightExpr case (tokenType op, left, right) of diff --git a/src/Lox/Parser.hs b/src/Lox/Parser.hs index 377d22e..4f91f8a 100644 --- a/src/Lox/Parser.hs +++ b/src/Lox/Parser.hs @@ -5,6 +5,8 @@ module Lox.Parser ( import Control.Monad import Control.Monad.State +import Data.Either +import Data.Maybe import Lox.Scanner import Lox.Expr @@ -13,18 +15,25 @@ data ParserState = ParserState {tokens :: [Token]} data ParserError = MismatchedParenthesesError | ExpectedExpressionError | ExpectedSemicolonError + | ExpectedVariableName + | InvalidAssignmentTarget deriving Show --- program → statement* EOF ; +-- program → declaration* EOF ; +-- +-- declaration → varDecl +-- | statement ; -- -- statement → exprStmt -- | printStmt ; -- -- exprStmt → expression ";" ; -- printStmt → "print" expression ";" ; +-- varDecl → "var" IDENTIFIER ( "=" expression )? ";" ; - --- expression → equality ; +-- expression → assignment ; +-- assignment → IDENTIFIER "=" assignment +-- | equality ; -- equality → comparison ( ( "!=" | "==" ) comparison )* ; -- comparison → term ( ( ">" | ">=" | "<" | "<=" ) term )* ; -- term → factor ( ( "-" | "+" ) factor )* ; @@ -32,7 +41,7 @@ data ParserError = MismatchedParenthesesError -- unary → ( "!" | "-" ) unary -- | primary ; -- primary → NUMBER | STRING | "true" | "false" | "nil" --- | "(" expression ")" ; +-- | "(" expression ")" | IDENTIFIER; parse :: [Token] -> Either ParserError [Stmt] parse tokens = evalState program (ParserState {tokens=tokens}) @@ -41,7 +50,7 @@ program :: State ParserState (Either ParserError [Stmt]) program = do atEnd <- isAtEnd if atEnd then return $ Right [] else do - headMaybe <- statement + headMaybe <- declaration case headMaybe of Left err -> return $ Left err Right head -> do @@ -49,6 +58,27 @@ program = do case tailMaybe of Left err -> return $ Left err Right tail -> return $ Right $ head : tail +declaration :: State ParserState (Either ParserError Stmt) +declaration = do + varMaybe <- matchToken [VAR] + case varMaybe of + Just _ -> varDeclaration + _ -> statement + +varDeclaration :: State ParserState (Either ParserError Stmt) +varDeclaration = do + maybeName <- consume IDENTIFIER ExpectedVariableName + case maybeName of + Left err -> return $ Left err + Right name -> do + hasInit <- isJust <$> matchToken [EQUAL] + initMaybe <- if hasInit then expression else return $ Right $ LiteralExpr NullObject + semicolonMaybe <- consume SEMICOLON ExpectedSemicolonError + case (initMaybe, semicolonMaybe) of + (Left err, _) -> return $ Left err + (_, Left err) -> return $ Left err + (Right init, Right _) -> return $ Right $ VariableStmt name init + statement :: State ParserState (Either ParserError Stmt) statement = do @@ -64,7 +94,7 @@ printStatement = do case (valueMaybe, semicolonMaybe) of (Left err, _) -> return $ Left err (_, Left err) -> return $ Left err - (Right value, Right _) -> return $ Right $ Print value + (Right value, Right _) -> return $ Right $ PrintStmt value expressionStatement :: State ParserState (Either ParserError Stmt) expressionStatement = do @@ -73,11 +103,24 @@ expressionStatement = do case (valueMaybe, semicolonMaybe) of (Left err, _) -> return $ Left err (_, Left err) -> return $ Left err - (Right value, Right _) -> return $ Right $ Expression value + (Right value, Right _) -> return $ Right $ ExpressionStmt value expression :: State ParserState (Either ParserError Expr) -expression = equality +expression = assignment + +assignment :: State ParserState (Either ParserError Expr) +assignment = do + maybeExpr <- equality + matchedEqual <- isJust <$> matchToken [EQUAL] + if matchedEqual then do + maybeValue <- assignment + case (maybeExpr, maybeValue) of + (Left err, _) -> return $ Left err + (_, Left err) -> return $ Left err + (Right (VariableExpr name), Right value) -> return $ Right $ AssignmentExpr name value + _ -> return $ Left InvalidAssignmentTarget + else return maybeExpr equality :: State ParserState (Either ParserError Expr) equality = do @@ -116,24 +159,25 @@ unary = do exprMaybe <- unary case exprMaybe of Left err -> return $ Left err - Right expr -> return $ Right $ Unary op expr + Right expr -> return $ Right $ UnaryExpr op expr primary :: State ParserState (Either ParserError Expr) primary = do token <- advance case tokenType token of - FALSE -> return $ Right $ Literal $ BoolObject False - TRUE -> return $ Right $ Literal $ BoolObject True - NIL -> return $ Right $ Literal NullObject - NUMBER -> return $ Right $ Literal $ tokenObject token - STRING -> return $ Right $ Literal $ tokenObject token + FALSE -> return $ Right $ LiteralExpr $ BoolObject False + TRUE -> return $ Right $ LiteralExpr $ BoolObject True + NIL -> return $ Right $ LiteralExpr NullObject + NUMBER -> return $ Right $ LiteralExpr $ tokenObject token + STRING -> return $ Right $ LiteralExpr $ tokenObject token LEFT_PAREN -> do exprMaybe <- expression case exprMaybe of Left err -> return $ Left err Right expr -> do consume RIGHT_PAREN MismatchedParenthesesError - return $ Right $ Grouping expr + return $ Right $ GroupingExpr expr + IDENTIFIER -> return $ Right $ VariableExpr token _ -> return $ Left ExpectedExpressionError matchTail :: [TokenType] -> State ParserState (Either ParserError Expr) -> State ParserState (Either ParserError (Maybe (Token, Expr))) @@ -151,7 +195,7 @@ matchTail tokenTypes f = do mergeExpressionMaybe :: Expr -> Maybe (Token, Expr) -> Expr mergeExpressionMaybe expr Nothing = expr -mergeExpressionMaybe left (Just (op, right)) = Binary left op right +mergeExpressionMaybe left (Just (op, right)) = BinaryExpr left op right matchToken :: [TokenType] -> State ParserState (Maybe Token) matchToken [] = return Nothing