diff options
| -rw-r--r-- | src/Eval.hs | 54 | ||||
| -rw-r--r-- | src/Parser.hs | 46 | ||||
| -rw-r--r-- | test.bruijn | 5 |
3 files changed, 87 insertions, 18 deletions
diff --git a/src/Eval.hs b/src/Eval.hs index 72c8985..4e73778 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -4,22 +4,68 @@ module Eval import Control.Exception import Control.Monad.State +import Debug.Trace +import Parser import System.Console.Haskeline import System.Environment import System.Exit import System.IO +import Text.Parsec hiding ( State + , try + ) -type Environment = [String] +type Environment = [(String, Expression)] +type Program = State Environment -eval :: String -> IO () -eval code = putStrLn "ok" +eval :: [String] -> Environment -> IO Environment +eval [] env = pure env +eval (line : ls) env = case parse parseLine "Evaluator" line of + Left err -> print err >> pure env + Right instr -> case instr of + Define name exp -> + let (res, env') = evalDefine name exp `runState` env + in case res of + Left err -> print err >> eval ls env' + Right _ -> eval ls env' + Evaluate exp -> putStrLn "ok" >> pure env + _ -> eval ls env + +evalVar :: String -> Program (Failable Expression) +evalVar var = state $ \e -> + ( case lookup var e of + Nothing -> Left $ UndeclaredFunction var + Just x -> Right x + , e + ) + +evalApp :: Expression -> Expression -> Program (Failable Expression) +evalApp f g = + evalExp f + >>= (\case + Left e -> pure $ Left e + Right f' -> fmap (Application f') <$> evalExp g + ) + +evalExp :: Expression -> Program (Failable Expression) +evalExp idx@(Bruijn _ ) = pure $ Right idx +evalExp ( Variable var) = evalVar var +evalExp ( Abstraction exp) = evalExp exp +evalExp ( Application f g) = evalApp f g + +evalDefine :: String -> Expression -> Program (Failable Expression) +evalDefine name exp = + evalExp exp + >>= (\case + Left e -> pure $ Left e + Right f -> modify ((name, f) :) >> pure (Right f) + ) evalFile :: String -> IO () evalFile path = do file <- try $ readFile path :: IO (Either IOError String) case file of Left exception -> print (exception :: IOError) - Right file -> eval file + Right file -> eval (lines file) [] >> putStrLn "Done" evalRepl :: String -> Environment -> InputT IO Environment evalRepl line env = outputStrLn (show env) >> pure env diff --git a/src/Parser.hs b/src/Parser.hs index 611261f..1f768bd 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -5,10 +5,18 @@ import Text.Parsec import Text.Parsec.Language import qualified Text.Parsec.Token as Token +data Error = SyntaxError ParseError | UndeclaredFunction String | InvalidIndex Int | FatalError String +instance Show Error where + show (SyntaxError err) = show err + show (UndeclaredFunction err) = "ERROR: undeclared function " <> show err + show (InvalidIndex err) = "ERROR: invalid index " <> show err + show (FatalError err) = show err +type Failable = Either Error + languageDef :: GenLanguageDef String u Identity languageDef = emptyDef { Token.commentLine = "#" , Token.identStart = letter - , Token.identLetter = alphaNum <|> char '_' + , Token.identLetter = alphaNum <|> char '?' , Token.reservedOpNames = ["[", "]"] } @@ -26,27 +34,38 @@ reservedOp = Token.reservedOp lexer parens :: Parser a -> Parser a parens = Token.parens lexer -data Expression = Index Int | Abstraction Int Expression | Application Expression Expression - deriving (Ord, Eq) +data Expression = Bruijn Int | Variable String | Abstraction Expression | Application Expression Expression + deriving (Ord, Eq, Show) data Instruction = Define String Expression | Evaluate Expression | Comment String + deriving (Show) parseAbstraction :: Parser Expression parseAbstraction = do reservedOp "[" - idc <- endBy1 digit spaces - build idc <$> parseExpression - where - build (idx : idc) body = - Abstraction ((read . pure :: Char -> Int) idx) $ build idc body - curry [] body = body + exp <- parseExpression + reservedOp "]" + pure $ Abstraction exp parseApplication :: Parser Expression parseApplication = do s <- sepBy1 parseSingleton spaces pure $ foldl1 Application s +parseBruijn :: Parser Expression +parseBruijn = do + idx <- digit + spaces + pure $ Bruijn $ (read . pure) idx + +parseVariable :: Parser Expression +parseVariable = do + var <- identifier + spaces + pure $ Variable var + parseSingleton :: Parser Expression -parseSingleton = parseAbstraction <|> parens parseApplication +parseSingleton = + parseAbstraction <|> parens parseApplication <|> parseBruijn <|> parseVariable parseExpression :: Parser Expression parseExpression = do @@ -56,11 +75,14 @@ parseExpression = do parseDefine :: Parser Instruction parseDefine = do var <- identifier - space + spaces Define var <$> parseExpression +parseComment :: Parser Instruction +parseComment = string "#" >> Comment <$> many letter + parseLine :: Parser Instruction -parseLine = try parseDefine +parseLine = try parseDefine <|> parseComment parseReplLine :: Parser Expression parseReplLine = try parseExpression diff --git a/test.bruijn b/test.bruijn index 7a2632d..c941535 100644 --- a/test.bruijn +++ b/test.bruijn @@ -1,5 +1,6 @@ -nil [[0]] +#nil [[0]] true [[1]] -false [[0]] +#false [[0]] id [0] +iota [0 [[[2 0 (1 0)]]] [[1]]] main id true |