awful lot of error handling
This commit is contained in:
parent
061303ccc0
commit
75a33c2d94
4 changed files with 103 additions and 67 deletions
16
app/Main.hs
16
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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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}))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue