mjau :)

app/Main.hs

@@ -1,4 +1,41 @@
 module Main where
 
+import Text.Megaparsec.Error (errorBundlePretty)
+
+import System.Environment
+import System.IO
+import System.Exit
+import qualified Data.Text.IO as T
+import Control.Monad ((<=<))
+
+import Parse (parseExpr)
+import Type (infer)
+import CompChez (comp)
+import Eval (eval)
+
 main :: IO ()
-main = putTextLn "mjau"
+main = getArgs >>= \case
+  [] -> processFile "stdin" stdin
+  xs -> mapM_ (\file -> processFile file =<< openFile file ReadMode) xs
+
+putStyle :: String -> IO () -- bold blue :)
+putStyle s = putStrLn ("\x1b[38;5;87m\x1b[1m=>> " ++ s ++ "\x1b[0m")
+
+processFile :: String -> Handle -> IO ()
+processFile f h = do
+  contents <- T.hGetContents h
+  case parseExpr f contents of
+    Left e -> putStrLn (errorBundlePretty e)
+    Right ast -> do
+      putStyle "Parse Successful"
+      print ast
+      putStyle "Type Checking / Inferring"
+      case infer [] ast of
+        Nothing -> putStrLn "=> Type error" >> exitWith (ExitFailure 1)
+        Just t -> print t
+      putStyle "Compiling to Chez"
+      putStrLn (comp ast)
+      putStyle "Evaluating"
+      print (eval [] ast)
+
+

example/fib

@@ -0,0 +1,6 @@
+let fib : Int -> Int = fix \f.\x.
+  if 2 > x
+    then 1
+    else f (x-1) + f (x-2)
+
+in fib 10

gecco.cabal

@@ -13,6 +13,8 @@ executable gecco
 
     build-depends:    base
                     , gecco
+                    , megaparsec
+                    , text
     hs-source-dirs:   app
     default-language: GHC2021
     default-extensions: LambdaCase
@@ -20,9 +22,7 @@ executable gecco
 
 
 library
-    exposed-modules:  Core
+    exposed-modules:  Syn
-                    , Val
-                    , Syn
                     , Eval
                     , Type
                     , Parse

src/Core.hs

@@ -1,4 +0,0 @@
-module Core where
-
-test :: String
-test = "mjau"

src/Eval.hs

@@ -1,7 +1,20 @@
 module Eval where
 
 import Syn
-import Val
+
+data Val
+  = I Int
+  | B Bool
+  | U
+  | Clos (Val -> Val)
+
+instance Show Val where
+  show (I i) = "I " ++ show i
+  show (B b) = "B " ++ show b
+  show U = "U"
+  show (Clos _) = "<CLOS>"
+
+type Ctx = [Val]
 
 eval :: Ctx -> Syn -> Val
 eval ctx (Var i) = ctx !! i

src/Parse.hs

@@ -9,6 +9,7 @@ import Control.Monad.Combinators.Expr
 import Data.Text (Text, unpack)
 import Data.Char (isLetter, isSpace)
 import Data.List (elemIndex)
+import Data.Maybe (maybeToList)
 import Control.Applicative ((<|>))
 import Control.Monad (guard)
 
@@ -24,8 +25,8 @@ instance ShowErrorComponent Text where
 skipSpace :: Parser ()
 skipSpace = L.space space1 (L.skipLineComment "--") (L.skipBlockComment "{-" "-}")
 
-parseExpr :: Text -> Either (ParseErrorBundle Text Text) Syn
+parseExpr :: String -> Text -> Either (ParseErrorBundle Text Text) Syn
-parseExpr = parse (parser []) "<FILE>"
+parseExpr = parse (parser [])
 
 parser :: Ctx -> Parser Syn
 parser ctx = do
@@ -69,7 +70,7 @@ parseSyn ctx = ns (makeExprParser (parseInnerSyn ctx) opTable)
 parseInnerSyn :: Ctx -> Parser Syn
 parseInnerSyn ctx = do
   l <- many (ns goL)
-  r <- many (ns goR)
+  r <- maybeToList <$> optional (ns goR)
   let lr = l ++ r
   guard (not (null lr))
   pure (foldl1 App lr)

src/TestProg.hs

@@ -1,7 +1,6 @@
 module TestProg where
 
 import Syn
-import Val
 import Eval
 
 fib :: Syn

src/Val.hs

@@ -1,15 +0,0 @@
-module Val where
-
-data Val
-  = I Int
-  | B Bool
-  | U
-  | Clos (Val -> Val)
-
-instance Show Val where
-  show (I i) = "I " ++ show i
-  show (B b) = "B " ++ show b
-  show U = "U"
-  show (Clos _) = "<CLOS>"
-
-type Ctx = [Val]