variables

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
 

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)

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

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

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