blocks
This commit is contained in:
parent
cf9ae469ba
commit
44f39a7cf2
4 changed files with 50 additions and 14 deletions
|
|
@ -1,5 +1,5 @@
|
||||||
module Lox.Environment (
|
module Lox.Environment (
|
||||||
Environment,
|
Environment (..),
|
||||||
emptyEnvironment,
|
emptyEnvironment,
|
||||||
define,
|
define,
|
||||||
get,
|
get,
|
||||||
|
|
@ -9,17 +9,26 @@ module Lox.Environment (
|
||||||
import Data.Map
|
import Data.Map
|
||||||
import Lox.Scanner
|
import Lox.Scanner
|
||||||
|
|
||||||
data Environment = Environment {variables :: Map String Object}
|
data Environment = Environment {enclosing :: Maybe Environment, variables :: Map String Object}
|
||||||
|
|
||||||
emptyEnvironment :: Environment
|
emptyEnvironment :: Environment
|
||||||
emptyEnvironment = Environment {variables=empty}
|
emptyEnvironment = Environment {enclosing=Nothing, variables=empty}
|
||||||
|
|
||||||
define :: String -> Object -> Environment -> Environment
|
define :: String -> Object -> Environment -> Environment
|
||||||
define key value env@Environment {variables=variables} = env {variables=insert key value variables}
|
define key value env@Environment {variables=variables} = env {variables=insert key value variables}
|
||||||
|
|
||||||
get :: String -> Environment -> Maybe Object
|
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 :: String -> Object -> Environment -> (Bool, Environment)
|
||||||
assign key value env@Environment {variables=variables} =
|
assign key value env@Environment {enclosing=enclosing, variables=variables} =
|
||||||
if member key variables then (True, env {variables=insert key value variables}) else (False, env)
|
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)
|
||||||
|
|
|
||||||
|
|
@ -6,6 +6,7 @@ module Lox.Expr (
|
||||||
import Lox.Scanner
|
import Lox.Scanner
|
||||||
|
|
||||||
data Stmt =
|
data Stmt =
|
||||||
|
BlockStmt [Stmt] |
|
||||||
ExpressionStmt Expr |
|
ExpressionStmt Expr |
|
||||||
PrintStmt Expr |
|
PrintStmt Expr |
|
||||||
VariableStmt Token Expr
|
VariableStmt Token Expr
|
||||||
|
|
|
||||||
|
|
@ -22,6 +22,7 @@ interpret :: [Stmt] -> State InterpreterState ()
|
||||||
interpret = foldr ((>>) . execute) (return ())
|
interpret = foldr ((>>) . execute) (return ())
|
||||||
|
|
||||||
execute :: Stmt -> State InterpreterState ()
|
execute :: Stmt -> State InterpreterState ()
|
||||||
|
execute (BlockStmt statements) = executeBlock statements
|
||||||
execute (PrintStmt expr) = do
|
execute (PrintStmt expr) = do
|
||||||
value <- evalFrom expr
|
value <- evalFrom expr
|
||||||
modify (\s@(InterpreterState {io=io}) -> s {io=io >> print value})
|
modify (\s@(InterpreterState {io=io}) -> s {io=io >> print value})
|
||||||
|
|
@ -30,6 +31,13 @@ execute (VariableStmt name expr) = do
|
||||||
value <- evalFrom expr
|
value <- evalFrom expr
|
||||||
modify (\s@(InterpreterState {environment=env}) -> s {environment=define (tokenLexeme name) value env})
|
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 -> IO Object
|
||||||
eval expr = return $ evalState (evalFrom expr) emptyInterpreter
|
eval expr = return $ evalState (evalFrom expr) emptyInterpreter
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -15,8 +15,9 @@ data ParserState = ParserState {tokens :: [Token]}
|
||||||
data ParserError = MismatchedParenthesesError
|
data ParserError = MismatchedParenthesesError
|
||||||
| ExpectedExpressionError
|
| ExpectedExpressionError
|
||||||
| ExpectedSemicolonError
|
| ExpectedSemicolonError
|
||||||
| ExpectedVariableName
|
| ExpectedVariableNameError
|
||||||
| InvalidAssignmentTarget
|
| ExpectedBraceAfterBlockError
|
||||||
|
| InvalidAssignmentTargetError
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
-- program → declaration* EOF ;
|
-- program → declaration* EOF ;
|
||||||
|
|
@ -25,11 +26,13 @@ data ParserError = MismatchedParenthesesError
|
||||||
-- | statement ;
|
-- | statement ;
|
||||||
--
|
--
|
||||||
-- statement → exprStmt
|
-- statement → exprStmt
|
||||||
-- | printStmt ;
|
-- | printStmt
|
||||||
|
-- | block ;
|
||||||
--
|
--
|
||||||
-- exprStmt → expression ";" ;
|
-- exprStmt → expression ";" ;
|
||||||
-- printStmt → "print" expression ";" ;
|
-- printStmt → "print" expression ";" ;
|
||||||
-- varDecl → "var" IDENTIFIER ( "=" expression )? ";" ;
|
-- varDecl → "var" IDENTIFIER ( "=" expression )? ";" ;
|
||||||
|
-- block → "{" declaration* "}" ;
|
||||||
|
|
||||||
-- expression → assignment ;
|
-- expression → assignment ;
|
||||||
-- assignment → IDENTIFIER "=" assignment
|
-- assignment → IDENTIFIER "=" assignment
|
||||||
|
|
@ -67,7 +70,7 @@ declaration = do
|
||||||
|
|
||||||
varDeclaration :: State ParserState (Either ParserError Stmt)
|
varDeclaration :: State ParserState (Either ParserError Stmt)
|
||||||
varDeclaration = do
|
varDeclaration = do
|
||||||
maybeName <- consume IDENTIFIER ExpectedVariableName
|
maybeName <- consume IDENTIFIER ExpectedVariableNameError
|
||||||
case maybeName of
|
case maybeName of
|
||||||
Left err -> return $ Left err
|
Left err -> return $ Left err
|
||||||
Right name -> do
|
Right name -> do
|
||||||
|
|
@ -82,11 +85,26 @@ varDeclaration = do
|
||||||
|
|
||||||
statement :: State ParserState (Either ParserError Stmt)
|
statement :: State ParserState (Either ParserError Stmt)
|
||||||
statement = do
|
statement = do
|
||||||
printMaybe <- matchToken [PRINT]
|
tokenMaybe <- matchToken [PRINT, LEFT_BRACE]
|
||||||
case printMaybe of
|
case tokenMaybe of
|
||||||
Just _ -> printStatement
|
Just (Token {tokenType=PRINT}) -> printStatement
|
||||||
|
Just (Token {tokenType=LEFT_BRACE}) -> do
|
||||||
|
result <- fmap BlockStmt <$> block
|
||||||
|
braceMaybe <- consume RIGHT_BRACE ExpectedBraceAfterBlockError
|
||||||
|
return $ braceMaybe >> result
|
||||||
_ -> expressionStatement
|
_ -> 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 :: State ParserState (Either ParserError Stmt)
|
||||||
printStatement = do
|
printStatement = do
|
||||||
valueMaybe <- expression
|
valueMaybe <- expression
|
||||||
|
|
@ -119,7 +137,7 @@ assignment = do
|
||||||
(Left err, _) -> return $ Left err
|
(Left err, _) -> return $ Left err
|
||||||
(_, Left err) -> return $ Left err
|
(_, Left err) -> return $ Left err
|
||||||
(Right (VariableExpr name), Right value) -> return $ Right $ AssignmentExpr name value
|
(Right (VariableExpr name), Right value) -> return $ Right $ AssignmentExpr name value
|
||||||
_ -> return $ Left InvalidAssignmentTarget
|
_ -> return $ Left InvalidAssignmentTargetError
|
||||||
else return maybeExpr
|
else return maybeExpr
|
||||||
|
|
||||||
equality :: State ParserState (Either ParserError Expr)
|
equality :: State ParserState (Either ParserError Expr)
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue