Basic functionality

6 files changed, 89 insertions, 58 deletions

diff --git a/bruijn.cabal b/bruijn.cabal
index 744058c..22628ab 100644
--- a/bruijn.cabal
+++ b/bruijn.cabal
@@ -26,6 +26,7 @@ source-repository head
 library
   exposed-modules:
       Eval
+      Helper
       Parser
       Reducer
   other-modules:
diff --git a/src/Eval.hs b/src/Eval.hs
index 3b5453b..c40a118 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -5,6 +5,7 @@ module Eval
 import           Control.Exception
 import           Control.Monad.State
 import           Debug.Trace
+import           Helper
 import           Parser
 import           Reducer
 import           System.Console.Haskeline
@@ -15,9 +16,6 @@ import           Text.Parsec             hiding ( State
                                                 , try
                                                 )
 
-type Environment = [(String, Expression)]
-type Program = State Environment
-
 evalVar :: String -> Program (Failable Expression)
 evalVar var = state $ \e ->
   ( case lookup var e of
@@ -51,7 +49,7 @@ evalDefine name exp =
 
 eval :: [String] -> Environment -> IO Environment
 eval []          env = pure env
-eval (line : ls) env = case parse parseLine "Evaluator" line of
+eval (line : ls) env = case parse parseLine "FILE" line of
   Left  err   -> print err >> pure env
   Right instr -> case instr of
     Define name exp ->
@@ -59,20 +57,16 @@ eval (line : ls) env = case parse parseLine "Evaluator" line of
       in  case res of
             Left  err -> print err >> eval ls env'
             Right _   -> (putStrLn $ name <> " = " <> show exp) >> eval ls env'
-    Evaluate exp ->
-      let (res, env') = evalExp exp `runState` env
-      in  putStrLn
-              (case res of
-                Left  err -> show err
-                Right exp -> show $ reduce exp
-              )
-            >> pure env
     _ -> eval ls env
 
+evalFunc :: String -> Environment -> IO Environment
+evalFunc func env = case lookup func env of
+  Nothing  -> (putStrLn $ func <> " not found") >> pure env
+  Just exp -> (print $ reduce exp) >> pure env
+
 -- TODO: Less duplicate code (liftIO?)
--- TODO: Convert back to my notation using custom show
 evalRepl :: String -> Environment -> InputT IO Environment
-evalRepl line env = case parse parseReplLine "Repl" line of
+evalRepl line env = case parse parseReplLine "REPL" line of
   Left  err   -> outputStrLn (show err) >> pure env
   Right instr -> case instr of
     Define name exp ->
@@ -88,14 +82,24 @@ evalRepl line env = case parse parseReplLine "Repl" line of
                 Right exp -> (show exp) <> "\n-> " <> (show $ reduce exp)
               )
             >> pure env
+    Load path ->
+      liftIO
+        $   (try $ readFile path :: IO (Either IOError String))
+        >>= (\case -- TODO: Make this more abstract and reusable
+              Left exception -> print (exception :: IOError) >> pure env
+              Right file -> eval (filter (not . null) $ lines file) [] >>= pure
+            )
     _ -> pure env
 
 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 (lines file) [] >> putStrLn "Done"
+    Left exception -> print (exception :: IOError)
+    Right file ->
+      eval (filter (not . null) $ lines file) []
+        >>= evalFunc "main"
+        >>  return ()
 
 repl :: Environment -> InputT IO ()
 repl env =
diff --git a/src/Helper.hs b/src/Helper.hs
new file mode 100644
index 0000000..a8e393e
--- /dev/null
+++ b/src/Helper.hs
@@ -0,0 +1,26 @@
+module Helper where
+
+import           Control.Monad.State
+import           Text.Parsec             hiding ( State )
+
+data Error = SyntaxError ParseError | UndeclaredFunction String | DuplicateFunction String | InvalidIndex Int | FatalError String
+instance Show Error where
+  show (SyntaxError        err) = show err
+  show (UndeclaredFunction err) = "ERROR: undeclared function " <> show err
+  show (DuplicateFunction  err) = "ERROR: duplicate function " <> show err
+  show (InvalidIndex       err) = "ERROR: invalid index " <> show err
+  show (FatalError         err) = show err
+type Failable = Either Error
+
+data Expression = Bruijn Int | Variable String | Abstraction Expression | Application Expression Expression
+  deriving (Ord, Eq)
+data Instruction = Define String Expression | Evaluate Expression | Comment String | Load String
+  deriving (Show)
+instance Show Expression where
+  show (Bruijn      x        ) = show x
+  show (Variable    var      ) = show var
+  show (Abstraction exp      ) = "[" <> show exp <> "]"
+  show (Application exp1 exp2) = "(" <> show exp1 <> " " <> show exp2 <> ")"
+
+type Environment = [(String, Expression)]
+type Program = State Environment
diff --git a/src/Parser.hs b/src/Parser.hs
index b6ab9fb..1669bcd 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -1,19 +1,11 @@
 module Parser where
 
 import           Data.Functor.Identity
+import           Helper
 import           Text.Parsec
 import           Text.Parsec.Language
 import qualified Text.Parsec.Token             as Token
 
-data Error = SyntaxError ParseError | UndeclaredFunction String | DuplicateFunction String | InvalidIndex Int | FatalError String
-instance Show Error where
-  show (SyntaxError        err) = show err
-  show (UndeclaredFunction err) = "ERROR: undeclared function " <> show err
-  show (DuplicateFunction  err) = "ERROR: duplicate 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
@@ -35,15 +27,14 @@ reservedOp = Token.reservedOp lexer
 parens :: Parser a -> Parser a
 parens = Token.parens lexer
 
-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)
+almostAnything :: Parser String
+almostAnything =
+  many1 $ oneOf ".`#~@$%^&*_+-=|;',/?[]<>(){} " <|> letter <|> digit
 
 parseAbstraction :: Parser Expression
 parseAbstraction = do
   reservedOp "["
-  exp <- parseExpression <|> parseBruijn
+  exp <- parseExpression
   reservedOp "]"
   pure $ Abstraction exp
 
@@ -65,11 +56,14 @@ parseVariable = do
   pure $ Variable var
 
 parseSingleton :: Parser Expression
-parseSingleton = parseAbstraction <|> parens parseApplication <|> parseVariable
+parseSingleton =
+  parseBruijn <|> parseAbstraction <|> parens parseApplication <|> parseVariable
 
 parseExpression :: Parser Expression
 parseExpression = do
+  spaces
   expr <- parseApplication <|> parseSingleton
+  spaces
   pure expr
 
 parseEvaluate :: Parser Instruction
@@ -90,10 +84,14 @@ parseReplDefine = do
   Define var <$> parseExpression
 
 parseComment :: Parser Instruction
-parseComment = string "#" >> Comment <$> many letter
+parseComment = string "#" >> Comment <$> almostAnything
+
+parseLoad :: Parser Instruction
+parseLoad = string ":load " >> Load <$> almostAnything
 
 parseLine :: Parser Instruction
 parseLine = try parseDefine <|> parseComment
 
 parseReplLine :: Parser Instruction
-parseReplLine = try parseReplDefine <|> parseComment <|> parseEvaluate
+parseReplLine =
+  try parseReplDefine <|> parseComment <|> parseEvaluate <|> parseLoad
diff --git a/src/Reducer.hs b/src/Reducer.hs
index 1bc001f..0760a82 100644
--- a/src/Reducer.hs
+++ b/src/Reducer.hs
@@ -2,41 +2,35 @@ module Reducer
   ( reduce
   ) where
 
-import           Data.Bifunctor                 ( first )
-import           Data.Set                hiding ( fold )
-import           Parser
+import           Helper
 
 -- TODO: Reduce variable -> later: only reduce main in non-repl
--- TODO: Use zero-based indexing (?)
 
-shiftUp :: Expression -> Int -> Expression
-shiftUp (Bruijn x) n = if x > n then Bruijn (pred x) else Bruijn x
-shiftUp (Application exp1 exp2) n =
-  Application (shiftUp exp1 n) (shiftUp exp2 n)
-shiftUp (Abstraction exp) n = Abstraction (shiftUp exp (succ n))
+(<+>) :: Expression -> Int -> Expression
+(<+>) (Bruijn x             ) n = if x > n then Bruijn (pred x) else Bruijn x
+(<+>) (Application exp1 exp2) n = Application (exp1 <+> n) (exp2 <+> n)
+(<+>) (Abstraction exp      ) n = Abstraction $ exp <+> (succ n)
 
-shiftDown :: Expression -> Int -> Expression
-shiftDown (Bruijn x) n = if x > n then Bruijn (succ x) else Bruijn x
-shiftDown (Application exp1 exp2) n =
-  Application (shiftDown exp1 n) (shiftDown exp2 n)
-shiftDown (Abstraction exp) n = Abstraction (shiftDown exp (succ n))
+(<->) :: Expression -> Int -> Expression
+(<->) (Bruijn x             ) n = if x > n then Bruijn (succ x) else Bruijn x
+(<->) (Application exp1 exp2) n = Application (exp1 <-> n) (exp2 <-> n)
+(<->) (Abstraction exp      ) n = Abstraction $ exp <-> (succ n)
 
 bind :: Expression -> Expression -> Int -> Expression
 bind exp (Bruijn x) n = if x == n then exp else Bruijn x
 bind exp (Application exp1 exp2) n =
   Application (bind exp exp1 n) (bind exp exp2 n)
-bind exp (Abstraction exp') n =
-  Abstraction (bind (shiftDown exp 0) exp' (succ n))
+bind exp (Abstraction exp') n = Abstraction (bind (exp <-> 0) exp' (succ n))
 
 step :: Expression -> Expression
-step (Bruijn exp) = Bruijn exp
-step (Application (Abstraction exp) app) =
-  shiftUp (bind (shiftDown app 0) exp 1) 1
-step (Application exp1 exp2) = Application (step exp1) (step exp2)
-step (Abstraction exp      ) = Abstraction (step exp)
+step (Bruijn exp                        ) = Bruijn exp
+step (Application (Abstraction exp) app ) = (bind (app <-> 0) exp 0) <+> 0
+step (Application exp1              exp2) = Application (step exp1) (step exp2)
+step (Abstraction exp                   ) = Abstraction (step exp)
 
 reduceable :: Expression -> Bool
-reduceable (Bruijn _                        ) = False
+reduceable (Bruijn   _                      ) = False
+reduceable (Variable _                      ) = True
 reduceable (Application (Abstraction _) _   ) = True
 reduceable (Application exp1 exp2) = reduceable exp1 || reduceable exp2
 reduceable (Abstraction exp                 ) = reduceable exp
diff --git a/test.bruijn b/test.bruijn
index c941535..cd5133b 100644
--- a/test.bruijn
+++ b/test.bruijn
@@ -1,6 +1,14 @@
-#nil [[0]]
+# Church numerals
+zero [[0]]
+succ [[[1 (2 1 0)]]]
+add [[[[3 1 (2 1 0)]]]]
+mul [[[2 (1 0)]]]
+exp [[0 1]]
+
+Y [[1 (0 0)] [1 (0 0)]]
+
 true [[1]]
-#false [[0]]
+false [[0]]
 id [0]
 iota [0 [[[2 0 (1 0)]]] [[1]]]
-main id true
+main id false