OK

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