blocks

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)

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

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
 

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)