loops

src/Lox/Expr.hs

@@ -10,7 +10,8 @@ data Stmt =
     ExpressionStmt Expr |
     IfStmt Expr Stmt (Maybe Stmt) |
     PrintStmt Expr |
-    VariableStmt Token Expr
+    VariableStmt Token Expr |
+    WhileStmt Expr Stmt
     deriving Show
 
 data Expr = 

src/Lox/Interpreter.hs

@@ -33,13 +33,19 @@ execute (PrintStmt expr) = do
 execute (VariableStmt name expr) = do
     value <- evalFrom expr
     modify (\s@(InterpreterState {environment=env}) -> s {environment=define (tokenLexeme name) value env})
+execute (WhileStmt condition body) = executeWhile condition body 
 
 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})
+    modify (\s@InterpreterState {environment=Environment {enclosing=Just enclosing}} -> s {environment=enclosing})
+
+executeWhile :: Expr -> Stmt -> State InterpreterState ()
+executeWhile condition body = do
+    shouldContinue <- evalFrom condition
+    when (isTruthy shouldContinue) $ execute body >> executeWhile condition body
 
 eval :: Expr -> IO Object
 eval expr = return $ evalState (evalFrom expr) emptyInterpreter

src/Lox/Parser.hs

@@ -21,14 +21,20 @@ data SyntaxError = SyntaxError String deriving Show
 --                | statement ;
 --
 -- statement      → exprStmt
+--                | forStmt
 --                | ifStmt
 --                | printStmt 
+--                | whileStmt
 --                | block ;
 --
 -- exprStmt       → expression ";" ;
+-- forStmt        → "for" "(" ( varDecl | exprStmt | ";" ) 
+--                  expression? ";"
+--                  expression? ") statement ;
 -- ifStmt         → "if" "(" expression ")" statement 
 --                ( "else" statement )? ;
 -- printStmt      → "print" expression ";" ;
+-- whileStmt      → "while" "(" expression ")" statement ;
 -- varDecl        → "var" IDENTIFIER ( "=" expression )? ";" ;
 -- block          → "{" declaration* "}" ;
 --
@@ -85,11 +91,13 @@ varDeclaration = do
 
 statement :: State ParserState (Either SyntaxError Stmt)
 statement = do
-    tokenMaybe <- matchToken [IF, PRINT, LEFT_BRACE]
+    tokenTypeMaybe <- fmap tokenType <$> matchToken [FOR, IF, PRINT, WHILE, LEFT_BRACE]
-    case tokenMaybe of
+    case tokenTypeMaybe of
-        Just (Token {tokenType=IF}) -> ifStatement
+        Just FOR -> forStatement
-        Just (Token {tokenType=PRINT}) -> printStatement
+        Just IF -> ifStatement
-        Just (Token {tokenType=LEFT_BRACE}) -> do 
+        Just PRINT -> printStatement
+        Just WHILE -> whileStatement
+        Just LEFT_BRACE -> do 
             result <- fmap BlockStmt <$> block
             braceMaybe <- consume RIGHT_BRACE $ SyntaxError "Expected '}' after block"
             return $ braceMaybe >> result
@@ -106,6 +114,31 @@ block = do
             (_, Left err) -> return $ Left err
             (Right decl, Right tail) -> return $ Right $ decl : tail
 
+forStatement :: State ParserState (Either SyntaxError Stmt)
+forStatement = do
+    leftParen <- consume LEFT_PAREN $ SyntaxError "Expected '(' after 'for'"
+    tokenTypeMaybe <- fmap tokenType <$> matchToken [SEMICOLON, VAR]
+    initializer <- case tokenTypeMaybe of
+        Just SEMICOLON -> return Nothing
+        Just VAR -> Just <$> varDeclaration
+        _ -> Just <$> expressionStatement
+    condition <- ifM (check SEMICOLON) (return Nothing) (Just <$> expression)
+    conditionSemicolon <- consume SEMICOLON $ SyntaxError "Expected ';' after loop condition"
+    increment <- ifM (check RIGHT_PAREN) (return Nothing) (Just <$> expression)
+    rightParen <- consume RIGHT_PAREN $ SyntaxError "Expected ')' after for clauses"
+    body <- statement
+    body1 <- case increment of
+        Just inc -> return $ BlockStmt <$> ((\x y -> [x, y]) <$> body <*> (ExpressionStmt <$> inc))
+        Nothing -> return body
+    cond1 <- case condition of
+        Just cond -> return cond
+        Nothing -> return $ Right $ LiteralExpr $ BoolObject True
+    let body2 = WhileStmt <$> cond1 <*> body1
+    body3 <- case initializer of
+        Just init -> return $ BlockStmt <$> ((\x y -> [x, y]) <$> init <*> body2)
+        Nothing -> return body2
+    return $ leftParen >> conditionSemicolon >> rightParen >> body3
+
 ifStatement :: State ParserState (Either SyntaxError Stmt)
 ifStatement = do
     leftParenMaybe <- consume LEFT_PAREN $ SyntaxError "Expected '(' after 'if'"
@@ -134,6 +167,13 @@ expressionStatement = do
         (_, Left err) -> return $ Left err
         (Right value, Right _) -> return $ Right $ ExpressionStmt value
     
+whileStatement :: State ParserState (Either SyntaxError Stmt)
+whileStatement = do
+    leftParenMaybe <- consume LEFT_PAREN $ SyntaxError "Expected '(' after 'if'"
+    conditionMaybe <- expression
+    rightParenMaybe <- consume RIGHT_PAREN $ SyntaxError "Expected ')' after if condition"
+    bodyMaybe <- statement
+    return $ WhileStmt <$> (leftParenMaybe >> conditionMaybe <* rightParenMaybe) <*> bodyMaybe
 
 expression :: State ParserState (Either SyntaxError Expr)
 expression = assignment