added debug info

src/Main.hs

@@ -3,6 +3,7 @@
 module Main where
 
 import Codegen.Codegen (generateCode)
+import Data.Bool (bool)
 import GHC.IO.Handle.Text (hPutStrLn)
 import Grammar.ErrM (Err)
 import Grammar.Par (myLexer, pProgram)
@@ -15,10 +16,13 @@ import           Data.List.Extra             (isSuffixOf)
 
 import Compiler (optimize)
 import Renamer.Renamer (rename)
-import           System.Directory            (createDirectory, doesPathExist,
+import System.Directory (
+    createDirectory,
+    doesPathExist,
     getDirectoryContents,
     removeDirectoryRecursive,
-                                              setCurrentDirectory)
+    setCurrentDirectory,
+ )
 import System.Environment (getArgs)
 import System.Exit (exitFailure, exitSuccess)
 import System.IO (stderr)
@@ -38,15 +42,15 @@ main' debug s = do
 
     printToErr "-- Parse Tree -- "
     parsed <- fromSyntaxErr . pProgram $ myLexer file
-    printToErr $ printTree parsed
+    bool (printToErr $ printTree parsed) (printToErr $ printTree parsed) debug
 
     printToErr "\n-- Renamer --"
     renamed <- fromRenamerErr . rename $ parsed
-    printToErr $ printTree renamed
+    bool (printToErr $ printTree renamed) (printToErr $ show renamed) debug
 
     printToErr "\n-- TypeChecker --"
     typechecked <- fromTypeCheckerErr $ typecheck renamed
-    printToErr $ printTree typechecked
+    bool (printToErr $ printTree typechecked) (printToErr $ show typechecked) debug
 
     -- printToErr "\n-- Lambda Lifter --"
     -- let lifted = lambdaLift typechecked
@@ -54,7 +58,7 @@ main' debug s = do
     --
     printToErr "\n -- Compiler --"
     generatedCode <- fromCompilerErr $ generateCode (monomorphize typechecked)
-    --putStrLn generatedCode
+    -- putStrLn generatedCode
 
     check <- doesPathExist "output"
     when check (removeDirectoryRecursive "output")

src/TypeChecker/TypeChecker.hs

@@ -129,7 +129,7 @@ checkBind err@(Bind name args e) = do
                 sub <- bindErr (unify t lambdaT) err
                 let newT = apply sub t
                 insertSig (coerce name) (Just newT)
-                return $ T.Bind (coerce name, newT) (map coerce args) e
+                return $ T.Bind (apply sub (coerce name, newT)) (map coerce args) e
             _ -> do
                 insertSig (coerce name) (Just lambdaT)
                 return (T.Bind (coerce name, lambdaT) (map coerce args) e) -- (apply s e)
@@ -481,6 +481,9 @@ instance SubstType T.Pattern where
 instance SubstType a => SubstType [a] where
     apply s = map (apply s)
 
+instance SubstType T.Id where
+    apply s (name, t) = (name, apply s t)
+
 -- | Apply substitutions to the environment.
 applySt :: Subst -> Infer a -> Infer a
 applySt s = local (\st -> st{vars = apply s (vars st)})