diff --git a/app/Main.hs b/app/Main.hs index a93fb36..ff2ce5f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -4,10 +4,18 @@ import Lox.Interpreter import System.IO run :: String -> IO () -run source = print result - where result = eval expr - expr = parse tokens - tokens = scanTokensFromSource source +run source = do + let tokensMaybe = scanTokensFromSource source + case tokensMaybe of + Left UnexpectedCharacterError -> putStrLn "Unexpected character" + Right tokens -> do + let exprMaybe = parse tokens + case exprMaybe of + Left ExpectedExpressionError -> putStrLn "Expected expression" + Left MismatchedParenthesesError -> putStrLn "Mismatched parentheses" + Right expr -> do + result <- eval expr + print result main :: IO () main = putStr ">> " >> hFlush stdout >> getLine >>= run diff --git a/src/Lox/Interpreter.hs b/src/Lox/Interpreter.hs index 29476bd..840b75d 100644 --- a/src/Lox/Interpreter.hs +++ b/src/Lox/Interpreter.hs @@ -8,8 +8,8 @@ import Control.Monad.State data InterpreterState = InterpreterState -eval :: Expr -> Object -eval expr = evalState (interpret expr) InterpreterState +eval :: Expr -> IO Object +eval expr = return $ evalState (interpret expr) InterpreterState interpret :: Expr -> State InterpreterState Object interpret (Literal value) = return value diff --git a/src/Lox/Parser.hs b/src/Lox/Parser.hs index d149c8c..1966224 100644 --- a/src/Lox/Parser.hs +++ b/src/Lox/Parser.hs @@ -1,4 +1,5 @@ module Lox.Parser ( + ParserError (..), parse ) where @@ -9,6 +10,8 @@ import Lox.Expr data ParserState = ParserState {tokens :: [Token]} +data ParserError = MismatchedParenthesesError | ExpectedExpressionError + -- expression → equality ; -- equality → comparison ( ( "!=" | "==" ) comparison )* ; -- comparison → term ( ( ">" | ">=" | "<" | "<=" ) term )* ; @@ -19,63 +22,82 @@ data ParserState = ParserState {tokens :: [Token]} -- primary → NUMBER | STRING | "true" | "false" | "nil" -- | "(" expression ")" ; -parse :: [Token] -> Expr +parse :: [Token] -> Either ParserError Expr parse tokens = evalState expression (ParserState {tokens=tokens}) -expression :: State ParserState Expr +expression :: State ParserState (Either ParserError Expr) expression = equality -equality :: State ParserState Expr +equality :: State ParserState (Either ParserError Expr) equality = do - expr <- comparison - mergeExpressionMaybe expr <$> matchTail [BANG_EQUAL, EQUAL_EQUAL] comparison + exprMaybe <- comparison + case exprMaybe of + Left err -> return $ Left err + Right expr -> fmap (mergeExpressionMaybe expr) <$> matchTail [BANG_EQUAL, EQUAL_EQUAL] comparison -comparison :: State ParserState Expr +comparison :: State ParserState (Either ParserError Expr) comparison = do - expr <- term - mergeExpressionMaybe expr <$> matchTail [GREATER, GREATER_EQUAL, LESS, LESS_EQUAL] term + exprMaybe <- term + case exprMaybe of + Left err -> return $ Left err + Right expr -> fmap (mergeExpressionMaybe expr) <$> matchTail [GREATER, GREATER_EQUAL, LESS, LESS_EQUAL] term -term :: State ParserState Expr +term :: State ParserState (Either ParserError Expr) term = do - expr <- factor - mergeExpressionMaybe expr <$> matchTail [MINUS, PLUS] factor + exprMaybe <- factor + case exprMaybe of + Left err -> return $ Left err + Right expr -> fmap (mergeExpressionMaybe expr) <$> matchTail [MINUS, PLUS] factor -factor :: State ParserState Expr +factor :: State ParserState (Either ParserError Expr) factor = do - expr <- unary - mergeExpressionMaybe expr <$> matchTail [SLASH, STAR] unary + exprMaybe <- unary + case exprMaybe of + Left err -> return $ Left err + Right expr -> fmap (mergeExpressionMaybe expr) <$> matchTail [SLASH, STAR] unary -unary :: State ParserState Expr +unary :: State ParserState (Either ParserError Expr) unary = do maybeOperator <- matchToken [BANG, MINUS] case maybeOperator of Nothing -> primary - Just op -> Unary op <$> unary + Just op -> do + exprMaybe <- unary + case exprMaybe of + Left err -> return $ Left err + Right expr -> return $ Right $ Unary op expr -primary :: State ParserState Expr +primary :: State ParserState (Either ParserError Expr) primary = do token <- advance case tokenType token of - FALSE -> return $ Literal $ BoolObject False - TRUE -> return $ Literal $ BoolObject True - NIL -> return $ Literal NullObject - NUMBER -> return $ Literal $ tokenObject token - STRING -> return $ Literal $ tokenObject token + 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 LEFT_PAREN -> do - expr <- expression - consume RIGHT_PAREN "Expected '(' after ')'" - return $ Grouping expr - _ -> error "Expected expression" + exprMaybe <- expression + case exprMaybe of + Left err -> return $ Left err + Right expr -> do + consume RIGHT_PAREN MismatchedParenthesesError + return $ Right $ Grouping expr + _ -> return $ Left ExpectedExpressionError -matchTail :: [TokenType] -> State ParserState Expr -> State ParserState (Maybe (Token, Expr)) +matchTail :: [TokenType] -> State ParserState (Either ParserError Expr) -> State ParserState (Either ParserError (Maybe (Token, Expr))) matchTail tokenTypes f = do maybeOperator <- matchToken tokenTypes case maybeOperator of - Nothing -> return Nothing + Nothing -> return $ Right Nothing Just op -> do - expr <- comparison - rest <- matchTail tokenTypes f - return $ Just (op, mergeExpressionMaybe expr rest) + exprMaybe <- comparison + restMaybe <- matchTail tokenTypes f + case (exprMaybe, restMaybe) of + (Left err, _) -> return $ Left err + (_, Left err) -> return $ Left err + (Right expr, Right rest) -> return $ Right $ Just (op, mergeExpressionMaybe expr rest) + mergeExpressionMaybe :: Expr -> Maybe (Token, Expr) -> Expr mergeExpressionMaybe expr Nothing = expr mergeExpressionMaybe left (Just (op, right)) = Binary left op right @@ -91,10 +113,10 @@ check t = do atEnd <- isAtEnd if atEnd then return False else (== t) . tokenType <$> peek -consume :: TokenType -> String -> State ParserState Token -consume t msg = do +consume :: TokenType -> ParserError -> State ParserState (Either ParserError Token) +consume t err = do isOk <- check t - if isOk then advance else error msg + if isOk then Right <$> advance else return $ Left err advance :: State ParserState Token advance = state (\s@ParserState {tokens=(t:ts)} -> (t, s {tokens = ts})) diff --git a/src/Lox/Scanner.hs b/src/Lox/Scanner.hs index 91dfbda..2570af4 100644 --- a/src/Lox/Scanner.hs +++ b/src/Lox/Scanner.hs @@ -2,6 +2,7 @@ module Lox.Scanner ( TokenType (..), Object (..), Token (..), + ScannerError (..), scanTokensFromSource ) where @@ -44,21 +45,24 @@ data Token = Token { data ScannerState = ScannerState {source :: String, current :: String, lineNumber :: Int} +data ScannerError = UnexpectedCharacterError + emptyScannerState :: String -> ScannerState emptyScannerState source = ScannerState {source=source, current="", lineNumber=1} -scanTokensFromSource :: String -> [Token] +scanTokensFromSource :: String -> Either ScannerError [Token] scanTokensFromSource source = evalState scanTokens (emptyScannerState source) -scanTokens :: State ScannerState [Token] +scanTokens :: State ScannerState (Either ScannerError [Token]) scanTokens = do atEnd <- isAtEnd - if atEnd then return <$> addToken EOF else do + if atEnd then return . return <$> addToken EOF else do maybeToken <- scanToken case maybeToken of - Nothing -> scanTokens - Just t -> (t :) <$> scanTokens + Right Nothing -> scanTokens + Right (Just t) -> fmap (fmap (t :)) scanTokens + Left err -> return $ Left err isAtEnd :: State ScannerState Bool isAtEnd = gets scannerIsAtEnd @@ -66,32 +70,34 @@ isAtEnd = gets scannerIsAtEnd scannerIsAtEnd :: ScannerState -> Bool scannerIsAtEnd ScannerState {source=source} = null source -scanToken :: State ScannerState (Maybe Token) +scanToken :: State ScannerState (Either ScannerError (Maybe Token)) scanToken = do resetCurrent c <- advance + let ok = Right . Just + let nothing = Right Nothing case c of - '(' -> Just <$> addToken LEFT_PAREN - ')' -> Just <$> addToken RIGHT_PAREN - '{' -> Just <$> addToken LEFT_BRACE - '}' -> Just <$> addToken RIGHT_BRACE - ',' -> Just <$> addToken COMMA - '.' -> Just <$> addToken DOT - '-' -> Just <$> addToken MINUS - '+' -> Just <$> addToken PLUS - ';' -> Just <$> addToken SEMICOLON - '*' -> Just <$> addToken STAR - '!' -> Just <$> ifM (match '=') (addToken BANG_EQUAL) (addToken BANG) - '=' -> Just <$> ifM (match '=') (addToken EQUAL_EQUAL) (addToken EQUAL) - '<' -> Just <$> ifM (match '=') (addToken LESS_EQUAL) (addToken LESS) - '>' -> Just <$> ifM (match '=') (addToken GREATER_EQUAL) (addToken GREATER) - '/' -> ifM (match '/') (advanceLine >> return Nothing) (Just <$> addToken SLASH) - '"' -> Just <$> scanString - ' ' -> return Nothing - '\r' -> return Nothing - '\t' -> return Nothing - '\n' -> return Nothing - c -> if isDigit c then Just <$> scanNumber else if isAlpha c then Just <$> scanIdentifier else error "Unexpected character" + '(' -> ok <$> addToken LEFT_PAREN + ')' -> ok <$> addToken RIGHT_PAREN + '{' -> ok <$> addToken LEFT_BRACE + '}' -> ok <$> addToken RIGHT_BRACE + ',' -> ok <$> addToken COMMA + '.' -> ok <$> addToken DOT + '-' -> ok <$> addToken MINUS + '+' -> ok <$> addToken PLUS + ';' -> ok <$> addToken SEMICOLON + '*' -> ok <$> addToken STAR + '!' -> ok <$> ifM (match '=') (addToken BANG_EQUAL) (addToken BANG) + '=' -> ok <$> ifM (match '=') (addToken EQUAL_EQUAL) (addToken EQUAL) + '<' -> ok <$> ifM (match '=') (addToken LESS_EQUAL) (addToken LESS) + '>' -> ok <$> ifM (match '=') (addToken GREATER_EQUAL) (addToken GREATER) + '/' -> ifM (match '/') (advanceLine >> return nothing) (ok <$> addToken SLASH) + '"' -> ok <$> scanString + ' ' -> return nothing + '\r' -> return nothing + '\t' -> return nothing + '\n' -> return nothing + c -> if isDigit c then ok <$> scanNumber else if isAlpha c then ok <$> scanIdentifier else return $ Left UnexpectedCharacterError scanString :: State ScannerState Token scanString = do