diff --git a/src/Lox/Environment.hs b/src/Lox/Environment.hs index cd1c35e..60ccd45 100644 --- a/src/Lox/Environment.hs +++ b/src/Lox/Environment.hs @@ -1,5 +1,5 @@ module Lox.Environment ( - Environment, + Environment (..), emptyEnvironment, define, get, @@ -9,17 +9,26 @@ module Lox.Environment ( import Data.Map import Lox.Scanner -data Environment = Environment {variables :: Map String Object} +data Environment = Environment {enclosing :: Maybe Environment, variables :: Map String Object} emptyEnvironment :: Environment -emptyEnvironment = Environment {variables=empty} +emptyEnvironment = Environment {enclosing=Nothing, 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 +get key Environment {enclosing=enclosing, variables=variables} = + case variables !? key of + Just val -> Just val + Nothing -> case enclosing of + Just e -> get key e + Nothing -> Nothing 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) +assign key value env@Environment {enclosing=enclosing, variables=variables} = + if member key variables + then (True, env {variables=insert key value variables}) + else case enclosing of + Just e -> let (success, newEnclosing) = assign key value e in (success, env {enclosing = Just newEnclosing}) + Nothing -> (False, env) diff --git a/src/Lox/Expr.hs b/src/Lox/Expr.hs index 4e89fe1..b13148d 100644 --- a/src/Lox/Expr.hs +++ b/src/Lox/Expr.hs @@ -6,6 +6,7 @@ module Lox.Expr ( import Lox.Scanner data Stmt = + BlockStmt [Stmt] | ExpressionStmt Expr | PrintStmt Expr | VariableStmt Token Expr diff --git a/src/Lox/Interpreter.hs b/src/Lox/Interpreter.hs index 25ce85a..3e858ba 100644 --- a/src/Lox/Interpreter.hs +++ b/src/Lox/Interpreter.hs @@ -22,6 +22,7 @@ interpret :: [Stmt] -> State InterpreterState () interpret = foldr ((>>) . execute) (return ()) execute :: Stmt -> State InterpreterState () +execute (BlockStmt statements) = executeBlock statements execute (PrintStmt expr) = do value <- evalFrom expr modify (\s@(InterpreterState {io=io}) -> s {io=io >> print value}) @@ -30,6 +31,13 @@ execute (VariableStmt name expr) = do value <- evalFrom expr modify (\s@(InterpreterState {environment=env}) -> s {environment=define (tokenLexeme name) value env}) +executeBlock :: [Stmt] -> State InterpreterState () +executeBlock statements = do + oldEnv <- gets environment + modify (\s@InterpreterState {environment=_} -> s {environment=emptyEnvironment {enclosing=Just oldEnv}}) + interpret statements + modify (\s@InterpreterState {environment=_} -> s {environment=oldEnv}) + eval :: Expr -> IO Object eval expr = return $ evalState (evalFrom expr) emptyInterpreter diff --git a/src/Lox/Parser.hs b/src/Lox/Parser.hs index 4f91f8a..8d2f185 100644 --- a/src/Lox/Parser.hs +++ b/src/Lox/Parser.hs @@ -15,8 +15,9 @@ data ParserState = ParserState {tokens :: [Token]} data ParserError = MismatchedParenthesesError | ExpectedExpressionError | ExpectedSemicolonError - | ExpectedVariableName - | InvalidAssignmentTarget + | ExpectedVariableNameError + | ExpectedBraceAfterBlockError + | InvalidAssignmentTargetError deriving Show -- program → declaration* EOF ; @@ -25,11 +26,13 @@ data ParserError = MismatchedParenthesesError -- | statement ; -- -- statement → exprStmt --- | printStmt ; +-- | printStmt +-- | block ; -- -- exprStmt → expression ";" ; -- printStmt → "print" expression ";" ; -- varDecl → "var" IDENTIFIER ( "=" expression )? ";" ; +-- block → "{" declaration* "}" ; -- expression → assignment ; -- assignment → IDENTIFIER "=" assignment @@ -67,7 +70,7 @@ declaration = do varDeclaration :: State ParserState (Either ParserError Stmt) varDeclaration = do - maybeName <- consume IDENTIFIER ExpectedVariableName + maybeName <- consume IDENTIFIER ExpectedVariableNameError case maybeName of Left err -> return $ Left err Right name -> do @@ -82,11 +85,26 @@ varDeclaration = do statement :: State ParserState (Either ParserError Stmt) statement = do - printMaybe <- matchToken [PRINT] - case printMaybe of - Just _ -> printStatement + tokenMaybe <- matchToken [PRINT, LEFT_BRACE] + case tokenMaybe of + Just (Token {tokenType=PRINT}) -> printStatement + Just (Token {tokenType=LEFT_BRACE}) -> do + result <- fmap BlockStmt <$> block + braceMaybe <- consume RIGHT_BRACE ExpectedBraceAfterBlockError + return $ braceMaybe >> result _ -> expressionStatement +block :: State ParserState (Either ParserError [Stmt]) +block = do + isRightBrace <- check RIGHT_BRACE + if isRightBrace then return $ Right [] else do + declMaybe <- declaration + tailMaybe <- block + case (declMaybe, tailMaybe) of + (Left err, _) -> return $ Left err + (_, Left err) -> return $ Left err + (Right decl, Right tail) -> return $ Right $ decl : tail + printStatement :: State ParserState (Either ParserError Stmt) printStatement = do valueMaybe <- expression @@ -119,7 +137,7 @@ assignment = do (Left err, _) -> return $ Left err (_, Left err) -> return $ Left err (Right (VariableExpr name), Right value) -> return $ Right $ AssignmentExpr name value - _ -> return $ Left InvalidAssignmentTarget + _ -> return $ Left InvalidAssignmentTargetError else return maybeExpr equality :: State ParserState (Either ParserError Expr)