From b4cae11c0d9d02c963f3d0dfde5701b99d705ac7 Mon Sep 17 00:00:00 2001
From: sebastianselander <sebastian.selander@gmail.com>
Date: Fri, 24 Mar 2023 18:26:59 +0100
Subject: [PATCH] added debug info

---
 src/Main.hs                    | 50 ++++++++++++++++++----------------
 src/TypeChecker/TypeChecker.hs |  5 +++-
 2 files changed, 31 insertions(+), 24 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index ba5b387..9f44c18 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -2,28 +2,32 @@
 
 module Main where
 
-import           Codegen.Codegen             (generateCode)
-import           GHC.IO.Handle.Text          (hPutStrLn)
-import           Grammar.ErrM                (Err)
-import           Grammar.Par                 (myLexer, pProgram)
-import           Grammar.Print               (printTree)
+import Codegen.Codegen (generateCode)
+import Data.Bool (bool)
+import GHC.IO.Handle.Text (hPutStrLn)
+import Grammar.ErrM (Err)
+import Grammar.Par (myLexer, pProgram)
+import Grammar.Print (printTree)
 
-import           Monomorphizer.Monomorphizer (monomorphize)
+import Monomorphizer.Monomorphizer (monomorphize)
 
-import           Control.Monad               (when)
-import           Data.List.Extra             (isSuffixOf)
+import Control.Monad (when)
+import Data.List.Extra (isSuffixOf)
 
-import           Compiler                    (optimize)
-import           Renamer.Renamer             (rename)
-import           System.Directory            (createDirectory, doesPathExist,
-                                              getDirectoryContents,
-                                              removeDirectoryRecursive,
-                                              setCurrentDirectory)
-import           System.Environment          (getArgs)
-import           System.Exit                 (exitFailure, exitSuccess)
-import           System.IO                   (stderr)
-import           System.Process.Extra        (spawnCommand, waitForProcess)
-import           TypeChecker.TypeChecker     (typecheck)
+import Compiler (optimize)
+import Renamer.Renamer (rename)
+import System.Directory (
+    createDirectory,
+    doesPathExist,
+    getDirectoryContents,
+    removeDirectoryRecursive,
+    setCurrentDirectory,
+ )
+import System.Environment (getArgs)
+import System.Exit (exitFailure, exitSuccess)
+import System.IO (stderr)
+import System.Process.Extra (spawnCommand, waitForProcess)
+import TypeChecker.TypeChecker (typecheck)
 
 main :: IO ()
 main =
@@ -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")
diff --git a/src/TypeChecker/TypeChecker.hs b/src/TypeChecker/TypeChecker.hs
index 9bcb67b..a114007 100644
--- a/src/TypeChecker/TypeChecker.hs
+++ b/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)})