From f0074abf179a25bf515a150ddef3a3865358d769 Mon Sep 17 00:00:00 2001
From: Koz Ross <koz.ross@retro-freedom.nz>
Date: Thu, 5 Sep 2024 12:50:54 +1200
Subject: [PATCH 1/2] Remove tracing from Purus modules

---
 src/Language/Purus/IR.hs                      |  42 ++---
 src/Language/Purus/Make.hs                    |  12 --
 src/Language/Purus/Pipeline/CompileToPIR.hs   |  29 +--
 src/Language/Purus/Pipeline/DesugarCore.hs    |  92 +--------
 src/Language/Purus/Pipeline/DesugarObjects.hs |  35 +---
 src/Language/Purus/Pipeline/EliminateCases.hs | 174 ++----------------
 .../Purus/Pipeline/GenerateDatatypes.hs       |  35 +---
 .../Purus/Pipeline/GenerateDatatypes/Utils.hs |  13 +-
 src/Language/Purus/Pipeline/Inline.hs         |  79 +-------
 src/Language/Purus/Pipeline/Instantiate.hs    |  19 +-
 src/Language/Purus/Pipeline/Lift.hs           |  46 +----
 src/Language/Purus/Utils.hs                   |   3 +-
 12 files changed, 77 insertions(+), 502 deletions(-)

diff --git a/src/Language/Purus/IR.hs b/src/Language/Purus/IR.hs
index 739d7c7f..01a66a29 100644
--- a/src/Language/Purus/IR.hs
+++ b/src/Language/Purus/IR.hs
@@ -41,7 +41,6 @@ import Language.PureScript.Types (
   genPureName,
  )
 
-import Language.Purus.Debug (doTrace)
 import Language.Purus.Pretty ((<::>))
 import Language.Purus.Pretty.Common (prettyStr)
 
@@ -805,30 +804,25 @@ expTy' f scoped = case instantiateEither (either (V . B) (V . F)) scoped of
   (Name might be a bit confusing, does not apply types)
 -}
 appType :: forall x t a. (TypeLike t, Pretty t) => (a -> Var (BVar t) (FVar t)) -> Exp x t a -> Exp x t a -> t
-appType h fe ae = doTrace "appType" msg result
+appType h fe ae = case unsafeAnalyzeApp (AppE fe ae) of 
+  (fe', ae') -> 
+    quantify
+      . foldr1Trace funTy
+      . drop (length ae')
+      . splitFunTyParts
+      . snd
+      . stripQuantifiers
+      $ instantiateWithArgs (expTy h fe') (expTy h <$> ae')
   where
-    errmsg =
-      ( "\nINPUT FUN:\n"
-          <> prettyStr (expTy h fe)
-          <> "\n\nINPUT ARGS:\n"
-          <> prettyStr (expTy h ae)
-      )
-
-    msg = errmsg <> "\n\nRESULT\n: " <> prettyStr result
-
-    foldr1Trace f xs
-      | null xs = error $ "appType\n\n" <> errmsg
-      | otherwise = foldr1 f xs
-
-    result = case unsafeAnalyzeApp (AppE fe ae) of
-      (fe', ae') ->
-        quantify
-          . foldr1Trace funTy
-          . drop (length ae')
-          . splitFunTyParts
-          . snd
-          . stripQuantifiers
-          $ instantiateWithArgs (expTy h fe') (expTy h <$> ae')
+    foldr1Trace :: forall b . (b -> b -> b) -> [b] -> b
+    foldr1Trace f = \case
+      [] -> error $ "appType\n\n" <> errmsg
+      xs -> foldr1 f xs
+    errmsg :: String
+    errmsg = "\nINPUTFun:\n" <>
+             prettyStr (expTy h fe) <>
+             "\n\nINPUT ARGS:\n" <>
+             prettyStr (expTy h ae)
 
 $(deriveShow1 ''BindE)
 
diff --git a/src/Language/Purus/Make.hs b/src/Language/Purus/Make.hs
index fb85b67f..3e1138ba 100644
--- a/src/Language/Purus/Make.hs
+++ b/src/Language/Purus/Make.hs
@@ -78,7 +78,6 @@ import System.FilePath.Glob qualified as Glob
 
 import PlutusCore.Evaluation.Result (EvaluationResult)
 
--- import Debug.Trace (traceM)
 -- import PlutusIR.Core.Instance.Pretty.Readable (prettyPirReadable)
 
 {-  Compiles a main function to PIR, given its module name, dependencies, and a
@@ -113,7 +112,6 @@ compile primModule orderedModules mainModuleName mainFunctionName =
     go = do
       (summedModule, dsCxt) <- runDesugarCore $ desugarCoreModules primModule orderedModules
       let
-        -- traceBracket lbl msg = traceM ("\n" <> lbl <> "\n\n" <> msg <> "\n\n")
         decls = moduleDecls summedModule
         declIdentsSet = foldBinds (\acc nm _ -> S.insert nm acc) S.empty decls
         couldn'tFindMain n =
@@ -126,26 +124,16 @@ compile primModule orderedModules mainModuleName mainFunctionName =
             <> "\nin declarations:\n"
             <> prettyStr (S.toList declIdentsSet)
       mainFunctionIx <- note (couldn'tFindMain 1) $ dsCxt ^? globalScope . at mainModuleName . folded . at mainFunctionName . folded
-      -- traceM $ "Found main function Index: " <> show mainFunctionIx
       mainFunctionBody <- note (couldn'tFindMain 2) $ findDeclBodyWithIndex mainFunctionName mainFunctionIx decls
-      -- traceM "Found main function body"
       inlined <- runInline summedModule $ lift (mainFunctionName, mainFunctionIx) mainFunctionBody >>= inline
-      -- traceBracket "Done inlining. Result:" $ prettyStr inlined
       let !instantiated = applyPolyRowArgs $ instantiateTypes inlined
-      -- traceBracket "Done instantiating types. Result:" $ prettyStr instantiated
       withoutObjects <- instantiateTypes <$> runCounter (desugarObjects instantiated)
-      -- traceBracket  "Desugared objects. Result:\n" $ prettyStr withoutObjects
       datatypes <- runCounter $ desugarObjectsInDatatypes (moduleDataTypes summedModule)
-      -- traceM "Desugared datatypes"
       runPlutusContext initDatatypeDict $ do
         generateDatatypes datatypes
-        -- traceM "Generated PIR datatypes"
         withoutCases <- eliminateCases datatypes withoutObjects
-        -- traceM "Eliminated case expressions. Compiling to PIR..."
         compileToPIR datatypes withoutCases
 
--- traceM . docString $ prettyPirReadable pirTerm
-
 modulesInDependencyOrder :: [[FilePath]] -> IO [Module (Bind Ann) PurusType PurusType Ann]
 modulesInDependencyOrder (concat -> paths) = do
   modules <- traverse decodeModuleIO paths
diff --git a/src/Language/Purus/Pipeline/CompileToPIR.hs b/src/Language/Purus/Pipeline/CompileToPIR.hs
index 3e1518ff..446143bb 100644
--- a/src/Language/Purus/Pipeline/CompileToPIR.hs
+++ b/src/Language/Purus/Pipeline/CompileToPIR.hs
@@ -24,7 +24,6 @@ import Language.PureScript.CoreFn.FromJSON ()
 import Language.PureScript.CoreFn.Module (
   Datatypes,
  )
-import Language.PureScript.CoreFn.TypeLike (TypeLike (..))
 import Language.PureScript.Names (
   Ident (..),
   Qualified (..),
@@ -33,7 +32,6 @@ import Language.PureScript.Names (
  )
 import Language.PureScript.PSString (prettyPrintString)
 
-import Language.Purus.Debug (doTraceM, prettify)
 import Language.Purus.IR (
   BVar (..),
   BindE (..),
@@ -41,8 +39,7 @@ import Language.Purus.IR (
   FVar (..),
   Lit (CharL, IntL, StringL),
   Ty,
-  expTy,
-  expTy',
+  expTy
  )
 import Language.Purus.IR qualified as IR
 import Language.Purus.IR.Utils (Vars, WithoutObjects, toExp)
@@ -85,12 +82,6 @@ compileToPIR _datatypes _exp = do
   resBody <- compileToPIR' _datatypes _exp
   datatypes <- view pirDatatypes
   let binds = NE.fromList $ map (PIR.DatatypeBind ()) . M.elems $ datatypes
-      msg =
-        prettify
-          [ "INPUT:\n" <> prettyStr _exp
-          , "OUTPUT (BODY):\n" <> prettyStr resBody
-          ]
-  doTraceM "compileToPIR" msg
   pure $ PIR.Let () PIR.Rec binds resBody
 
 compileToPIR' ::
@@ -98,7 +89,7 @@ compileToPIR' ::
   Exp WithoutObjects Ty (Vars Ty) ->
   PlutusContext PIRTerm
 compileToPIR' datatypes _exp =
-  doTraceM "compileToPIR'" (prettyStr _exp) >> case _exp of
+  case _exp of
     V x -> case x of
       F Unit -> pure $ mkConstant () ()
       F (FVar _ ident@(Qualified _ (runIdent -> nm))) ->
@@ -117,24 +108,12 @@ compileToPIR' datatypes _exp =
                     <> "report this bug to the Purus authors. "
       B (BVar bvix _ (runIdent -> nm)) -> pure $ PIR.Var () (Name nm $ Unique bvix)
     LitE _ lit -> compileToPIRLit lit
-    lam@(LamE (BVar bvIx bvT bvNm) body) -> do
-      let lty = funTy bvT (expTy' id body)
+    (LamE (BVar bvIx bvT bvNm) body) -> do
       ty' <- toPIRType bvT
       let nm = Name (runIdent bvNm) $ Unique bvIx
           body' = toExp body
       body'' <- compileToPIR' datatypes body'
-      let result = PIR.LamAbs () nm ty' body''
-          msg =
-            "BVar:\n"
-              <> prettyStr bvNm
-              <> "\n\nInput Lam:\n"
-              <> prettyStr lam
-              <> "\n\nInferred Lam Ty:\n"
-              <> prettyStr lty
-              <> "\n\nRESULT: "
-              <> prettyStr result
-      doTraceM "compileToPIRLamTy" msg
-      pure result
+      pure $ PIR.LamAbs () nm ty' body''
     AppE e1 e2 -> do
       e1' <- compileToPIR' datatypes e1
       e2' <- compileToPIR' datatypes e2
diff --git a/src/Language/Purus/Pipeline/DesugarCore.hs b/src/Language/Purus/Pipeline/DesugarCore.hs
index 651f68b9..f93684d6 100644
--- a/src/Language/Purus/Pipeline/DesugarCore.hs
+++ b/src/Language/Purus/Pipeline/DesugarCore.hs
@@ -1,4 +1,3 @@
-{-# LANGUAGE TypeApplications #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 
@@ -12,7 +11,6 @@ import Data.Map qualified as M
 import Data.Text (Text)
 import Data.Text qualified as T
 
-import Data.Char (isUpper)
 import Data.Foldable (Foldable (foldl'), foldrM, traverse_)
 import Data.List (sort, sortOn)
 import Data.Maybe (fromJust, isJust)
@@ -35,7 +33,6 @@ import Language.PureScript.CoreFn.Expr (
  )
 import Language.PureScript.CoreFn.Module (Datatypes, Module (..))
 import Language.PureScript.CoreFn.TypeLike (TypeLike (..))
-import Language.PureScript.CoreFn.Utils (exprType)
 import Language.PureScript.Environment (mkCtorTy, mkTupleTyName)
 import Language.PureScript.Names (
   Ident (..),
@@ -49,11 +46,6 @@ import Language.PureScript.Names (
  )
 import Language.PureScript.Types (Type (..))
 
-import Language.Purus.Debug (
-  doTrace,
-  doTraceM,
-  prettify,
- )
 import Language.Purus.IR (
   Alt (..),
   BVar (..),
@@ -63,7 +55,6 @@ import Language.Purus.IR (
   FuncType (..),
   Lit (CharL, IntL, ObjectL, StringL),
   Pat (..),
-  expTy,
  )
 import Language.Purus.IR.Utils (
   IR_Decl,
@@ -80,7 +71,6 @@ import Language.Purus.Pipeline.Monad (
   globalScope,
   localScope,
  )
-import Language.Purus.Pretty (prettyStr, prettyTypeStr, renderExprStr)
 import Language.Purus.Pretty.Common qualified as PC
 
 import Bound (Var (..), abstract)
@@ -98,9 +88,6 @@ import Control.Lens (
   (^?),
  )
 
-import Debug.Trace (traceM)
-import Prettyprinter (Pretty (..))
-
 {- This runs the computation in an empty *local* context. The globals (i.e. top level declarations and
    imports are still in scope.)
 
@@ -117,8 +104,6 @@ bindLocal :: Ident -> DesugarCore Int
 bindLocal ident = do
   i <- next
   modify $ over localScope (M.insert ident i) -- localScope . at ident .= i
-  s <- view localScope
-  doTraceM "bind" ("IDENT: " <> T.unpack (runIdent ident) <> "\n\nINDEX: " <> prettyStr i <> "\n\nSCOPE:\n" <> prettyStr (M.toList s))
   pure i
 
 {- Binds a "global" variable to the specific index.
@@ -135,13 +120,6 @@ forceBindGlobal mn i indx = do
       over globalScope (M.insert mn M.empty)
   modify $ over (globalScope . ix mn) (M.insert i indx)
 
-{- -}
-isCtorOrPrim :: Exp x t (Vars t) -> Bool
-isCtorOrPrim = \case
-  V (F (FVar _ (Qualified (ByModuleName (ModuleName "Prim")) _))) -> True
-  V (F (FVar _ (Qualified _ (Ident i)))) -> isUpper (T.head i)
-  _ -> False
-
 {- We don't bind anything b/c the type level isn't `Bound` -}
 tyAbs :: forall x t. Text -> KindOf t -> Exp x t (Vars t) -> DesugarCore (Exp x t (Vars t))
 tyAbs nm k exp' = do
@@ -186,10 +164,7 @@ desugarCoreModule inScope imports Module {..} = do
   decls' <- traverse (freshly . desugarCoreDecl . doEtaReduce) moduleDecls
   decls <- bindLocalTopLevelDeclarations decls'
   let allDatatypes = moduleDataTypes <> inScope
-  s <- get
-  traceM $ "DesugarContext for " <> prettyStr moduleName <> "\n" <> prettyStr s
   let result = Module {moduleDecls = decls <> imports, moduleDataTypes = allDatatypes, ..}
-  -- traceM $ "Desugar Coure output for " <> prettyStr moduleName <> "\n" <> docString (prettyModule result)
   pure result
   where
     doEtaReduce = \case
@@ -203,13 +178,7 @@ desugarCoreModule inScope imports Module {..} = do
       let topLevelIdents = foldBinds (\acc nm _ -> nm : acc) [] ds
       traverse_ (uncurry (forceBindGlobal moduleName)) topLevelIdents
       s <- get
-      doTraceM "bindLocalTopLevelDeclarations" $
-        prettify
-          [ -- "Input (Module Decls):\n" <> prettify (prettyStr <$> ds)
-            "Top level idents:\n" <> prettify (prettyStr <$> topLevelIdents)
-          , "State:\n" <> prettyStr s
-          ]
-      -- this is only safe because every locally-scoped (i.e. inside a decl) variable should be
+        -- this is only safe because every locally-scoped (i.e. inside a decl) variable should be
       -- bound by this point
       let upd = \case
             V (B bv) -> V $ B bv
@@ -232,20 +201,6 @@ desugarCoreDecl = \case
     let scoped = abstr desugared
     pure $ NonRecursive ident bvix scoped
   Rec xs -> do
-    let inMsg =
-          concatMap
-            ( \((_, i), x) ->
-                prettyStr i
-                  <> " :: "
-                  <> prettyTypeStr (exprType x)
-                  <> "\n"
-                  <> prettyStr i
-                  <> " = "
-                  <> renderExprStr x
-                  <> "\n\n"
-            )
-            xs
-    doTraceM "desugarCoreDecl" inMsg
     first_pass <- traverse (\((_, ident), e) -> bindLocal ident >>= \u -> pure ((ident, u), e)) xs
     s <- view localScope
     let abstr = abstract (matchLet s)
@@ -258,7 +213,6 @@ desugarCoreDecl = \case
               pure ((ident, bvix), scoped)
         )
         first_pass
-    doTraceM "desugarCoreDecl" ("RESULT (RECURSIVE):\n" <> prettyStr (fmap fromScope <$> second_pass))
     pure $ Recursive second_pass
 
 {- | Turns a list of expressions into an n-ary
@@ -280,22 +234,11 @@ tuplify es = foldl' (App nullAnn) tupCtor es
     tupCtor = Var nullAnn tupCtorType (properToIdent <$> tupName)
 
 desugarCore :: Expr Ann -> DesugarCore (Exp WithObjects PurusType (Vars PurusType))
-desugarCore e = do
-  let ty = exprType e
-  result <- desugarCore' e
-  let msg =
-        prettify
-          [ "INPUT:\n" <> renderExprStr e
-          , "INPUT TY:\n" <> prettyTypeStr ty
-          , "OUTPUT:\n" <> prettyStr result
-          , "OUTPUT TY:\n" <> prettyStr (expTy id result)
-          ]
-  doTraceM "desugarCore" msg
-  pure result
+desugarCore = desugarCore'
 
 desugarCore' :: Expr Ann -> DesugarCore (Exp WithObjects PurusType (Vars PurusType))
 desugarCore' (Literal _ann ty lit) = LitE ty <$> desugarLit lit
-desugarCore' lam@(Abs _ann ty ident expr) = do
+desugarCore' (Abs _ann ty ident expr) = do
   bvIx <- bindLocal ident
   s <- view localScope
   expr' <- desugarCore' expr
@@ -303,21 +246,7 @@ desugarCore' lam@(Abs _ann ty ident expr) = do
       (vars', _) = stripQuantifiers ty
       vars = (\(_, b, c) -> (b, c)) <$> vars'
       scopedExpr = abstract (matchLet s) expr'
-  result <- tyAbsMany vars $ LamE (BVar bvIx ty' ident) scopedExpr
-  let msg =
-        prettify
-          [ "ANNOTATED LAM TY:\n" <> prettyStr ty
-          , "BOUND VAR TY:\n" <> prettyStr ty'
-          , "BOUND VAR INDEX: " <> prettyStr bvIx
-          , "BOUND VAR IDENT: " <> prettyStr ident
-          , "BODY TY:\n" <> prettyStr (exprType expr)
-          , "INPUT EXPR:\n" <> renderExprStr lam
-          , "RESULT EXPR:\n" <> prettyStr result
-          , "RESULT EXPR TY:\n" <> prettyStr (expTy id result)
-          , "LOCAL SCOPE:\n" <> prettyStr (M.toList s)
-          ]
-  doTraceM "desugarCoreLam" msg
-  pure result
+  tyAbsMany vars $ LamE (BVar bvIx ty' ident) scopedExpr
 desugarCore' appE@(App {}) = case fromJust $ PC.analyzeApp appE of
   (f, args) -> do
     f' <- desugarCore f
@@ -451,17 +380,12 @@ matchVarLamAbs nm bvix (FVar ty n')
   | nm == disqualify n' = Just (BVar bvix ty nm)
   | otherwise = Nothing
 
-matchLet :: (Pretty ty) => M.Map Ident Int -> Vars ty -> Maybe (BVar ty)
+matchLet :: M.Map Ident Int -> Vars ty -> Maybe (BVar ty)
 matchLet _ (B bv) = Just bv
-matchLet binds fv@(F (FVar ty n')) = case result of
+matchLet binds (F (FVar ty n')) = case result of
   Nothing -> Nothing
-  Just _ -> doTrace "matchLet" msg result
+  Just _ -> result
   where
-    msg =
-      "INPUT:\n"
-        <> prettyStr fv
-        <> "\n\nOUTPUT:\n"
-        <> prettyStr result
     result = do
       let nm = disqualify n'
       bvix <- M.lookup nm binds
@@ -490,7 +414,7 @@ etaReduce input = case partitionLam input of
       let (bvars, inner) = stripLambdas e
       (f, args) <- analyzeAppCfn inner
       argBVars <- traverse argToBVar args
-      pure $ (bvars, f, argBVars)
+      pure (bvars, f, argBVars)
 
     argToBVar :: Expr ann -> Maybe Ident
     argToBVar = \case
diff --git a/src/Language/Purus/Pipeline/DesugarObjects.hs b/src/Language/Purus/Pipeline/DesugarObjects.hs
index 636c8e61..3229ddf1 100644
--- a/src/Language/Purus/Pipeline/DesugarObjects.hs
+++ b/src/Language/Purus/Pipeline/DesugarObjects.hs
@@ -37,7 +37,6 @@ import Language.PureScript.Types (
   srcTypeApp,
   srcTypeConstructor,
  )
-import Language.Purus.Debug (doTraceM)
 import Language.Purus.IR (
   Alt (..),
   BVar (..),
@@ -49,7 +48,6 @@ import Language.Purus.IR (
   Pat (..),
   Ty (..),
   expTy,
-  ppExp,
   pattern (:~>),
  )
 import Language.Purus.IR.Utils (
@@ -139,19 +137,7 @@ rowLast t = case rowToList t of
 desugarObjects ::
   Exp WithObjects SourceType (Vars SourceType) ->
   Counter (Exp WithoutObjects Ty (Vars Ty))
-desugarObjects __expr = do
-  result <- go __expr
-  let msg =
-        "INPUT:\n"
-          <> ppExp __expr
-          <> "\n\nINPUT TY:\n"
-          <> prettyStr (expTy id __expr)
-          <> "\n\nRESULT:\n"
-          <> ppExp result
-          <> "\n\nRESULT TY:\n"
-          <> prettyStr (expTy id result)
-  doTraceM "desugarObjects" msg
-  pure result
+desugarObjects __expr = go __expr
   where
     go ::
       Exp WithObjects SourceType (Vars SourceType) ->
@@ -369,7 +355,7 @@ desugarObjects __expr = do
           PSString ->
           Exp WithObjects SourceType (Vars SourceType) ->
           Counter (Exp WithoutObjects Ty (Vars Ty))
-        desugarObjectAccessor resTy lbl e = do
+        desugarObjectAccessor _ lbl e = do
           _fs <- case expTy id e of
             RecordT fs -> pure fs
             other ->
@@ -394,21 +380,6 @@ desugarObjects __expr = do
               rhs = V . B $ BVar n fieldTy dummyNm
               altBranch = F <$> UnguardedAlt ctorBndr (toScope rhs)
           e' <- desugarObjects e
-          let result = CaseE fieldTy e' [altBranch]
-              msg =
-                "INPUT EXP:\n"
-                  <> prettyStr e
-                  <> "\n\nLABEL:\n"
-                  <> prettyStr lbl
-                  <> "\n\nSUPPLIED RESTYPE:\n"
-                  <> prettyStr resTy
-                  <> "\n\nFIELD TYPES:\n"
-                  <> prettyStr types'
-                  <> "\n\nRESULT RHS:\n"
-                  <> prettyStr rhs
-                  <> "\n\nOUTPUT RESULT:\n"
-                  <> prettyStr result
-          doTraceM "desugarObjectAccessor" msg
           pure $ CaseE fieldTy e' [altBranch]
 
 assembleDesugaredObjectLit :: forall x a. Exp x Ty a -> Ty -> [Exp x Ty a] -> Counter (Exp x Ty a)
@@ -418,7 +389,7 @@ assembleDesugaredObjectLit _ _ _ = error "something went wrong in assembleDesuga
 
 purusTypeToKind :: SourceType -> Either String Kind
 purusTypeToKind _t =
-  doTraceM "sourceTypeToKind" (prettyStr _t) >> case _t of
+  case _t of
     TypeConstructor _ C.Type -> pure KindType
     t1 :-> t2 -> do
       t1' <- purusTypeToKind t1
diff --git a/src/Language/Purus/Pipeline/EliminateCases.hs b/src/Language/Purus/Pipeline/EliminateCases.hs
index ca29be87..914167db 100644
--- a/src/Language/Purus/Pipeline/EliminateCases.hs
+++ b/src/Language/Purus/Pipeline/EliminateCases.hs
@@ -31,10 +31,7 @@ import Language.PureScript.CoreFn.TypeLike (
   TypeLike (
     applyType,
     funTy,
-    instTy,
-    quantify,
-    replaceAllTypeVars,
-    splitFunTyParts
+    replaceAllTypeVars
   ),
   getAllInstantiations,
   getInstantiations,
@@ -46,13 +43,11 @@ import Language.PureScript.Names (
   ProperNameType (..),
   Qualified (..),
   runIdent,
-  showQualified,
  )
 import Language.PureScript.Types (
   TypeVarVisibility (TypeVarVisible),
  )
 
-import Language.Purus.Debug (doTrace, doTraceM, prettify)
 import Language.Purus.IR (
   Alt (..),
   BVar (BVar),
@@ -145,7 +140,6 @@ eliminateCases ::
   PlutusContext (Exp WithoutObjects Ty (Var (BVar Ty) (FVar Ty)))
 eliminateCases datatypes _exp = do
   res <- eliminateCaseExpressions datatypes . desugarIrrefutables . desugarLiteralPatterns $ _exp
-  doTraceM "eliminateCaseExpressions" ("INPUT:\n" <> prettyStr _exp <> "\n\nOUTPUT:\n" <> prettyStr res)
   pure
     . instantiateNullaryWithAnnotatedType datatypes
     . instantiateCtors datatypes
@@ -181,13 +175,6 @@ eliminateCaseExpressions datatypes = \case
     case ezMonomorphize $ monomorphizePatterns datatypes ce of
       CaseE resTy _scrut _alts -> do
         let retTy = case head _alts of UnguardedAlt _ e -> expTy' id e
-            msg =
-              prettify
-                [ "ANN RES TY:\n " <> prettyStr resTy
-                , "SCRUTINEE:\n" <> prettyStr _scrut
-                , "ALTS:\n" <> prettyStr _alts
-                ]
-        doTraceM "eliminateCaseExpressions" msg
         scrut <- eliminateCaseExpressions datatypes _scrut
         alts <- traverse eliminateCasesInAlt _alts
         desugarConstructorPattern datatypes retTy (CaseE resTy scrut alts)
@@ -240,14 +227,6 @@ mkDestructorFunTy datatypes tn = do
           ctorfs = map snd . view cdCtorFields <$> dDecl ^. dDataCtors
       let funTyRHS = tyAppliedToArgs :~> mkFunTyRHS outVar ctorfs -- foldr funTy outVar funTyCtorArgs
       let result = funTyLHS funTyRHS
-      doTraceM
-        "mkDestructorFunTy"
-        $ prettify
-          [ "TYPE NAME:\n" <> prettyStr tn
-          , "TY CTOR FIELDS:\n" <> prettyStr ctorfs
-          , "TY RHS:\n" <> prettyStr funTyRHS
-          , "RESULT:\n" <> prettyStr result
-          ]
       pure (null tyArgs, result)
   where
     mkFunTyRHS outVar [] = outVar
@@ -269,10 +248,7 @@ desugarConstructorPattern datatypes altBodyTy _e =
               conPatAlts = takeWhile isConP alts
               scrutTy = expTy id scrut
           indexedBranches <- sortOn fst <$> traverse (mkIndexedBranch scrutTy) conPatAlts
-          let branchTy = expTy id . snd . head $ indexedBranches
-              branchSplit = splitFunTyParts branchTy
-              branchRetTy = last . splitFunTyParts $ branchTy
-              allCtors = zip [0 ..] $ getAllConstructorDecls tn datatypes
+          let allCtors = zip [0 ..] $ getAllConstructorDecls tn datatypes
           (Name dcTor (Unique dctorIx)) <- getDestructorTy tn
           (isNullaryTyCon, dctorTy) <- mkDestructorFunTy datatypes tn
           let destructorRaw = V . B $ BVar dctorIx dctorTy (Ident dcTor)
@@ -281,30 +257,12 @@ desugarConstructorPattern datatypes altBodyTy _e =
                 | isNullaryTyCon = id
                 | otherwise = mkInstantiateTyCon (expTy id scrut)
 
-              retTy' = mkInstantiateResTy scrutTy altBodyTy
           -- NOTE: We'll need more sophisticated "pattern sorting" with as patterns
           case dropWhile isConP alts of
             [] -> do
               -- In this branch we know we have exhaustive constructor patterns in the alts
               let destructor = TyInstE altBodyTy (AppE (instantiateTyCon destructorRaw) scrut)
-                  result = foldl' AppE destructor (snd <$> indexedBranches)
-                  msg =
-                    prettify
-                      [ "INPUT TY:\n" <> prettyStr _eTy
-                      , "RESULT TY:\n" <> prettyStr (expTy id result)
-                      , "DESTRUCTOR TY:\n" <> prettyStr (expTy id destructor)
-                      , "ORIGINAL CASE RES TY:\n" <> prettyStr _resTy
-                      , "DEDUCED BRANCH RES TY:\n" <> prettyStr branchRetTy
-                      , "SPLIT BRANCH TY:\n" <> prettyStr branchSplit
-                      , "FULL BRANCH TY:\n" <> prettyStr branchTy
-                      , "SCRUT TY:\n" <> prettyStr scrutTy
-                      , "SCRUT EXPR:\n" <> prettyStr scrut
-                      , "RESULT:\n" <> prettyStr result
-                      , "ALT BODY TY:\n" <> prettyStr altBodyTy
-                      , "INSTANTIATED ALT BODY TY:\n" <> prettyStr retTy'
-                      ]
-              doTraceM "desugarConstructorPattern" msg
-              pure result
+              pure $ foldl' AppE destructor (snd <$> indexedBranches)
             irrefutables -> do
               let destructor = TyInstE altBodyTy (AppE (instantiateTyCon destructorRaw) scrut)
                   {- This is confusing and I keep making mistakes, so what's going on with 'irrefutables' is:
@@ -365,25 +323,7 @@ desugarConstructorPattern datatypes altBodyTy _e =
                           then scrut
                           else V . B $ bv
                     other -> error $ "Expected an irrefutable alt but got: " <> prettyStr other
-              result <- assemblePartialCtorCase (CtorCase irrefutable (M.fromList indexedBranches) destructor scrutTy) allCtors
-              let msg =
-                    prettify
-                      [ "INPUT TY:\n" <> prettyStr _eTy
-                      , "INPUT:\n" <> prettyStr _e
-                      , "RESULT TY:\n" <> prettyStr (expTy id result)
-                      , "DESTRUCTOR TY:\n" <> prettyStr (expTy id destructor)
-                      , "ORIGINAL CASE RES TY:\n" <> prettyStr _resTy
-                      , "DEDUCED BRANCH RES TY:\n" <> prettyStr branchRetTy
-                      , "SPLIT BRANCH TY:\n" <> prettyStr branchSplit
-                      , "FULL BRANCH TY:\n" <> prettyStr branchTy
-                      , "SCRUT TY:\n" <> prettyStr scrutTy
-                      , "SCRUT EXPR:\n" <> prettyStr scrut
-                      , "RESULT:\n" <> prettyStr result
-                      , "ALT BODY TY:\n" <> prettyStr altBodyTy
-                      , "INSTANTIATED ALT BODY TY:\n" <> prettyStr retTy'
-                      ]
-              doTraceM "desugarConstructorPattern" msg
-              pure result
+              assemblePartialCtorCase (CtorCase irrefutable (M.fromList indexedBranches) destructor scrutTy) allCtors
         other -> pure other
   where
     assemblePartialCtorCase :: CtorCase -> [(Int, CtorDecl Ty)] -> PlutusContext (Exp WithoutObjects Ty (Var (BVar Ty) (FVar Ty)))
@@ -423,45 +363,17 @@ desugarConstructorPattern datatypes altBodyTy _e =
       Ty ->
       Exp WithoutObjects Ty (Var (BVar Ty) (FVar Ty)) ->
       Exp WithoutObjects Ty (Var (BVar Ty) (FVar Ty))
-    mkInstantiateTyCon t e = doTrace "instantiateTyCon" msg result
+    mkInstantiateTyCon t e = result
       where
         result = case analyzeTyApp t of
           Just (_, tyArgs) -> foldr TyInstE e (reverse tyArgs)
           Nothing -> e
 
-        resTy = expTy id result
-
-        msg =
-          prettify
-            [ "INPUT TY:\n" <> prettyStr t
-            , "INPUT EXPR:\n" <> prettyStr e
-            , "INPUT EXPR TY:\n" <> prettyStr (expTy id e)
-            , "OUTPUT TY:\n" <> prettyStr resTy
-            , "OUTPUT:\n" <> prettyStr result
-            ]
-    {- This is a bit weird. If the alt body type is already quantified then we don't want to
-       do any instantiations. TODO: Explain why (kind of complicated)
-    -}
-    mkInstantiateResTy :: Ty -> Ty -> Ty
-    mkInstantiateResTy _ altT@(Forall {}) = doTrace "instantiateResTy" ("UNCHANGED:\n" <> prettyStr altT) altT
-    mkInstantiateResTy scrutT altT = doTrace "instantiateResTy" msg result
-      where
-        result = case analyzeTyApp scrutT of
-          Just (_, tyArgs) -> foldr instTy (quantify altT) (reverse tyArgs)
-          Nothing -> altT
-        msg =
-          prettify
-            [ "INPUT SCRUT TY:\n" <> prettyStr scrutT
-            , "INPUT TARG TY:\n" <> prettyStr altT
-            , "OUTPUT TY:\n" <> prettyStr result
-            ]
-
     mkIndexedBranch ::
       Ty ->
       Alt WithoutObjects Ty (Exp WithoutObjects Ty) (Var (BVar Ty) (FVar Ty)) ->
       PlutusContext (Int, Exp WithoutObjects Ty (Var (BVar Ty) (FVar Ty)))
-    mkIndexedBranch scrutTy alte@(UnguardedAlt (ConP tn cn binders) rhs) = do
-      doTraceM "mkIndexedBranch" ("INPUT:\n" <> prettyStr alte)
+    mkIndexedBranch scrutTy (UnguardedAlt (ConP tn cn binders) rhs) = do
       let go (x, t) acc = case x of
             VarP bvId bvIx bvTy' -> do
               let lamBV = BVar bvIx bvTy' bvId
@@ -476,14 +388,12 @@ desugarConstructorPattern datatypes altBodyTy _e =
               pure $ LamE lamBv . toScope . fmap F . acc
             other -> error $ "Unexpected pattern in alternative: Expected a VarP but got " <> show other
           monoFields = snd $ monoCtorFields tn cn scrutTy datatypes
-      doTraceM "mkIndexedBranch" ("MONO FIELDS:\n" <> prettyStr monoFields)
       lambdaLHS <- foldrM go id (zip binders monoFields)
       let indx = case fst <$> getConstructorIndexAndDecl cn datatypes of
             Left _ -> error $ "No constructor data for ctor " <> show cn
             Right i -> i
           rhsUnscoped = toExp rhs
           result = lambdaLHS rhsUnscoped
-      doTraceM "mkIndexedBranch" ("RESULT:\n" <> prettyStr result)
       pure (indx, result)
     mkIndexedBranch _ (UnguardedAlt otherP _) = error $ "mkIndexedBranch: Expected constructor pattern but got " <> prettyStr otherP
 
@@ -509,17 +419,7 @@ instantiateCtor datatypes expr = case expr of
                 Just tn -> tn
               monoFields = monoCtorInst tyNm ctorNm (funResultTy t) datatypes
               fe' = foldr TyInstE fe monoFields
-              result = foldl' AppE fe' args
-              msg =
-                prettify
-                  [ "NAME:" <> T.unpack (showQualified runIdent n)
-                  , "MONO TYPE:\n" <> prettyStr t
-                  , "INPUT:\n" <> prettyStr expr
-                  , "RESULT:\n" <> prettyStr result
-                  , "MONO FIELDS:\n" <> prettyStr monoFields
-                  , "INSTANTIATED FUN:\n" <> prettyStr fe'
-                  ]
-           in doTrace "instantiateCtor" msg result
+                in foldl' AppE fe' args
     _ -> expr
   _ -> expr
 
@@ -528,13 +428,8 @@ instantiateNullaryWithAnnotatedType ::
   Datatypes IR.Kind Ty ->
   Exp x Ty (Vars Ty) ->
   Exp x Ty (Vars Ty)
-instantiateNullaryWithAnnotatedType datatypes _e = doTrace "instantiateNullaryWithAnnotatedType" msg result
+instantiateNullaryWithAnnotatedType datatypes _e = result
   where
-    msg =
-      prettify
-        [ "INPUT:\n" <> prettyStr _e
-        , "OUTPUT:\n" <> prettyStr result
-        ]
     result = transform go _e
     go ::
       Exp x Ty (Vars Ty) ->
@@ -557,23 +452,8 @@ monoCtorInst ::
   Ty -> -- the type of the scrutinee
   Datatypes IR.Kind Ty ->
   [Ty] -- Constructor index & list of field types
-monoCtorInst tn cn t datatypes = doTrace "monoCtorInst" msg $ snd <$> reverse instantiations
+monoCtorInst tn _ t datatypes = snd <$> reverse instantiations
   where
-    msg =
-      "TYPE NAME:"
-        <> T.unpack (showQualified runProperName tn)
-        <> "CTOR NAME:\n"
-        <> T.unpack (showQualified runProperName cn)
-        <> "MONO IN TYPE:\n"
-        <> prettyStr t
-        <> "CTOR DECL ARGS:\n"
-        <> prettyStr ctorArgs
-        <> "POLY TY:\n"
-        <> prettyStr polyTy
-        <> "INSTANTIATIONS:\n"
-        <> prettyStr instantiations
-    (_, thisCtorDecl) = either error id $ getConstructorIndexAndDecl cn datatypes
-    ctorArgs = snd <$> thisCtorDecl ^. cdCtorFields
     thisDataDecl = fromJust $ lookupDataDecl tn datatypes
     declArgVars = uncurry IR.TyVar <$> thisDataDecl ^. dDataArgs
     dataTyCon = TyCon tn
@@ -593,18 +473,8 @@ monoCtorFields ::
   Ty -> -- the type of the scrutinee
   Datatypes IR.Kind Ty ->
   (Int, [Ty]) -- Constructor index & list of field types
-monoCtorFields tn cn t datatypes = doTrace "monoCtorFields" msg (thisCtorIx, monoCtorArgs)
+monoCtorFields tn cn t datatypes = (thisCtorIx, monoCtorArgs)
   where
-    msg =
-      prettify
-        [ "TYPE NAME:" <> T.unpack (showQualified runProperName tn)
-        , "CTOR NAME:\n" <> T.unpack (showQualified runProperName cn)
-        , "MONO IN TYPE:\n" <> prettyStr t
-        , "CTOR DECL ARGS:\n" <> prettyStr ctorArgs
-        , "POLY TY:\n" <> prettyStr polyTy
-        , "RESULT TYS:\n" <> prettyStr monoCtorArgs
-        , "INSTANTIATIONS:\n" <> prettyStr instantiations
-        ]
     (thisCtorIx, thisCtorDecl) = either error id $ getConstructorIndexAndDecl cn datatypes
     ctorArgs = snd <$> thisCtorDecl ^. cdCtorFields
     thisDataDecl = fromJust $ lookupDataDecl tn datatypes
@@ -646,8 +516,7 @@ monomorphizePatterns datatypes _e' = case _e' of
   CaseE resTy scrut alts ->
     let scrutTy = expTy id scrut
         alts' = goAlt scrutTy <$> alts -- REVIEW: Why do we do this twice? Was there a reason or is this just a mistake?
-        res = CaseE resTy scrut $ goAlt scrutTy <$> alts'
-     in doTrace "monomorphizePatterns" ("INPUT:\n" <> prettyStr _e' <> "RESULT:\n" <> prettyStr res) res
+     in CaseE resTy scrut $ goAlt scrutTy <$> alts'
   other -> other
   where
     monomorphPat ::
@@ -779,21 +648,6 @@ ezMonomorphize = transform go
             instantiations' ->
               let instantiations = reverse (snd <$> instantiations')
                   f' = foldr TyInstE f instantiations
-                  result = foldl' AppE f' args
-                  msg =
-                    prettify
-                      [ "INPUT:\n" <> prettyStr expr
-                      , "OUTPUT:\n"
-                      , prettyStr result
-                      ]
-               in doTrace "ezMonomorphize" msg result
-          ft ->
-            let msg =
-                  prettify
-                    [ "NO CHANGE (NOT A FORALL):"
-                    , "FUN TY:\n" <> prettyStr ft
-                    , "ARG TYPES:\n" <> prettyStr (expTy id <$> args)
-                    , "ORIGINAL EXPR:\n" <> prettyStr expr
-                    ]
-             in doTrace "ezMonomorphize" msg expr
-      _ -> expr -- doTrace "ezMonomorphize" ("" <> prettyStr expr) expr
+                in foldl' AppE f' args
+          _ -> expr
+      _ -> expr 
diff --git a/src/Language/Purus/Pipeline/GenerateDatatypes.hs b/src/Language/Purus/Pipeline/GenerateDatatypes.hs
index b10d2476..f8321018 100644
--- a/src/Language/Purus/Pipeline/GenerateDatatypes.hs
+++ b/src/Language/Purus/Pipeline/GenerateDatatypes.hs
@@ -37,7 +37,6 @@ import Language.PureScript.CoreFn.Module (
   tyDict,
  )
 import Language.PureScript.CoreFn.TypeLike
-import Language.PureScript.Environment (pattern (:->))
 import Language.PureScript.Names (
   ProperName (..),
   ProperNameType (..),
@@ -45,12 +44,7 @@ import Language.PureScript.Names (
   showQualified,
   pattern ByThisModuleName,
  )
-import Language.PureScript.Types (
-  SourceType,
-  Type (TypeConstructor),
- )
 
-import Language.Purus.Debug (doTraceM)
 import Language.Purus.IR (
   Ty (..),
   ppTy,
@@ -63,14 +57,11 @@ import Language.Purus.Pipeline.GenerateDatatypes.Utils (
   mkConstrName,
   mkNewTyVar,
   mkTyName,
-  prettyQPN,
  )
 import Language.Purus.Pipeline.Monad (
   MonadCounter (next),
   PlutusContext,
  )
-import Language.Purus.Pretty.Common (prettyStr)
-import Language.Purus.Pretty.Types (prettyTypeStr)
 import Language.Purus.Types (PIRType, destructors, pirDatatypes)
 
 import PlutusCore qualified as PLC
@@ -118,9 +109,7 @@ mkPIRDatatypes ::
   Datatypes IR.Kind Ty ->
   S.Set (Qualified (ProperName 'TypeName)) ->
   PlutusContext ()
-mkPIRDatatypes datatypes tyConsInExp =
-  doTraceM "mkPIRDatatypes" (show $ S.map prettyQPN tyConsInExp)
-    >> traverse_ go tyConsInExp
+mkPIRDatatypes datatypes tyConsInExp = traverse_ go tyConsInExp
   where
     -- these things don't have datatype definitions anywhere
     truePrimitives = S.fromList [C.Function, C.Int, C.Char, C.String]
@@ -130,7 +119,7 @@ mkPIRDatatypes datatypes tyConsInExp =
       PlutusContext ()
     go qn | qn `S.member` truePrimitives = pure ()
     go qn@(Qualified _ (ProperName tnm)) =
-      doTraceM "mkPIRDatatypes" ("go: " <> prettyQPN qn) >> case lookupDataDecl qn datatypes of
+      case lookupDataDecl qn datatypes of
         Nothing ->
           throwError $
             "Error when translating data types to PIR: "
@@ -138,10 +127,7 @@ mkPIRDatatypes datatypes tyConsInExp =
               <> T.unpack (showQualified runProperName qn)
         Just dDecl -> do
           -- TODO: newtypes should probably be newtype-ey
-          let declArgs = fst <$> dDecl ^. dDataArgs
-              declKind = mkDeclKind $ mkKind . snd <$> dDecl ^. dDataArgs
-          doTraceM "mkPIRDatatypes" $ "Decl " <> prettyStr dDecl
-          doTraceM "mkPIRDatatypes" $ "decl args: " <> show declArgs
+          let declKind = mkDeclKind $ mkKind . snd <$> dDecl ^. dDataArgs
           tyName <- mkTyName qn
           let typeNameDecl = TyVarDecl () tyName declKind
               dataArgs = dDecl ^. dDataArgs
@@ -159,7 +145,7 @@ mkPIRDatatypes datatypes tyConsInExp =
       (Int, CtorDecl Ty) ->
       PlutusContext (PIR.VarDecl PIR.TyName PIR.Name PLC.DefaultUni ())
     mkCtorDecl qTyName dataArgs (cix, ctorDecl) =
-      doTraceM "mkCtorDecl" (prettyQPN qTyName) >> do
+      do
         let ctorFields = snd <$> ctorDecl ^. cdCtorFields
             resultTy' = foldl' TyApp (TyCon qTyName) (uncurry TyVar <$> dataArgs)
             ctorFunTy :: Ty
@@ -189,20 +175,13 @@ toPIRType _ty = case _ty of
     ByThisModuleName "Prim" | isJust (handlePrimTy qtn) -> pure . fromJust $ handlePrimTy qtn
     _ -> do
       tyName <- mkTyName qtn
-      let result = PIR.TyVar () tyName
-      doTraceM "toPIRType" ("\nINPUT:\n" <> prettyStr _ty <> "\n\nRESULT:\n" <> prettyStr result)
-      pure result
-  IR.TyApp t1 t2 -> do
-    result <- goTypeApp t1 t2
-    doTraceM "toPIRType" ("\nINPUT:\n" <> prettyStr _ty <> "\n\nRESULT:\n" <> prettyStr result)
-    pure result
+      pure $ PIR.TyVar () tyName
+  IR.TyApp t1 t2 -> goTypeApp t1 t2
   Forall _ v k ty _ -> do
     vTyName <- mkNewTyVar v
     bindTV v vTyName
     ty' <- toPIRType ty
-    let result = TyForall () vTyName (mkKind k) ty'
-    doTraceM "toPIRType" ("\nINPUT:\n" <> prettyStr _ty <> "\n\nRESULT:\n" <> prettyStr result)
-    pure result
+    pure $ TyForall () vTyName (mkKind k) ty'
   other -> error $ "Upon reflection, other types like " <> ppTy other <> " shouldn't be allowed in the Ty ast"
   where
     goTypeApp (IR.TyApp (TyCon C.Function) a) b = do
diff --git a/src/Language/Purus/Pipeline/GenerateDatatypes/Utils.hs b/src/Language/Purus/Pipeline/GenerateDatatypes/Utils.hs
index 49611b40..e352abc7 100644
--- a/src/Language/Purus/Pipeline/GenerateDatatypes/Utils.hs
+++ b/src/Language/Purus/Pipeline/GenerateDatatypes/Utils.hs
@@ -24,7 +24,6 @@ import Data.Text (Text)
 import Data.Text qualified as T
 
 import Control.Monad.State (gets, modify)
-import Debug.Trace (traceM)
 
 import Language.PureScript.CoreFn.TypeLike
 import Language.PureScript.Names (
@@ -38,7 +37,6 @@ import Language.PureScript.Names (
   showQualified,
  )
 
-import Language.Purus.Debug (doTraceM)
 import Language.Purus.IR (
   Ty (..),
  )
@@ -86,7 +84,7 @@ pseudoRandomChar i = fst $ randomR ('a', 'z') (mkStdGen i)
 
 mkTyName :: Qualified (ProperName 'TypeName) -> PlutusContext PIR.TyName
 mkTyName qn =
-  doTraceM "mkTyName" (prettyQPN qn) >> gets (view tyNames) >>= \tnames -> case M.lookup qn tnames of
+  gets (view tyNames) >>= \tnames -> case M.lookup qn tnames of
     Just tyname -> pure tyname
     Nothing -> do
       uniq <- next
@@ -96,7 +94,7 @@ mkTyName qn =
 
 mkConstrName :: Qualified Ident -> Int -> PlutusContext PIR.Name
 mkConstrName qi cix =
-  doTraceM "mkConstrName" (prettyQI qi) >> gets (view constrNames) >>= \cnames -> case M.lookup qi cnames of
+  gets (view constrNames) >>= \cnames -> case M.lookup qi cnames of
     Just cname -> pure $ fst cname
     Nothing -> do
       uniq <- next
@@ -107,7 +105,7 @@ mkConstrName qi cix =
 -- | Only gives you a TyName, doesn't insert anything into the context
 mkNewTyVar :: Text -> PlutusContext TyName
 mkNewTyVar nm =
-  doTraceM "mkNewTyVar" (T.unpack nm) >> do
+  do
     uniq <- next
     pure . PIR.TyName $ PIR.Name nm $ PLC.Unique uniq
 
@@ -120,7 +118,7 @@ freshName = do
 
 getBoundTyVarName :: Text -> PlutusContext PIR.TyName
 getBoundTyVarName nm =
-  doTraceM "mkBoundTyVarName" (T.unpack nm) >> do
+  do
     boundTyVars <- gets _tyVars
     case M.lookup nm boundTyVars of
       Just tyName -> pure tyName
@@ -145,9 +143,8 @@ getDestructorTy qn = do
 
 getConstructorName :: Qualified Ident -> PlutusContext (Maybe PLC.Name)
 getConstructorName qi =
-  doTraceM "getConstructorName" (show qi) >> do
+  do
     ctors <- gets (view constrNames)
-    traceM $ show ctors
     pure $ ctors ^? at qi . folded . _1
 
 prettyQPN :: Qualified (ProperName 'TypeName) -> String
diff --git a/src/Language/Purus/Pipeline/Inline.hs b/src/Language/Purus/Pipeline/Inline.hs
index 85c26e0d..fb58be20 100644
--- a/src/Language/Purus/Pipeline/Inline.hs
+++ b/src/Language/Purus/Pipeline/Inline.hs
@@ -18,7 +18,6 @@ import Control.Monad.State (
   evalState,
   execState,
   unless,
-  void,
   when,
  )
 
@@ -32,7 +31,6 @@ import Language.PureScript.Environment (pattern RecordT)
 -- for the instance
 import Language.PureScript.Names (
   Ident (GenIdent, Ident),
-  runIdent,
  )
 import Language.PureScript.Types (
   Type (
@@ -47,7 +45,6 @@ import Language.PureScript.Types (
   isMonoType,
  )
 
-import Language.Purus.Debug (doTrace, doTraceM, prettify)
 import Language.Purus.IR (
   BVar (..),
   BindE (..),
@@ -94,7 +91,6 @@ import Language.Purus.Pipeline.Lift.Types (
   pattern LiftedHole,
  )
 import Language.Purus.Pipeline.Monad (Inline, MonadCounter (next))
-import Language.Purus.Pretty.Common (prettyStr)
 
 import Algebra.Graph.AdjacencyMap (
   AdjacencyMap (..),
@@ -114,14 +110,6 @@ import Control.Lens.Operators ((.=), (^..))
 import Bound (Var (..))
 import Bound.Scope (abstract)
 
-import Prettyprinter (
-  Pretty (pretty),
-  align,
-  hardline,
-  vcat,
-  (<+>),
- )
-
 inline :: LiftResult -> Inline MonoExp
 inline (LiftResult decls bodyE) = do
   declsPrepared <- inlineInLifted decls
@@ -192,17 +180,7 @@ inline (LiftResult decls bodyE) = do
               t = expTy id e'
               free = freeTypeVariables t
           bvars <- traverse (\(nm, ki) -> next >>= \u -> pure $ BVar u ki (Ident nm)) free
-          let result = foldr TyAbs e' bvars
-              msg =
-                prettify
-                  [ "INPUT EXPR:\n" <> prettyStr e
-                  , "INPUT EXPR TY:\n" <> prettyStr t <> "\n\n" <> show (void t)
-                  , "FREE TY VARS IN INPUT:\n" <> prettyStr free
-                  , "RESULT:\n" <> prettyStr result
-                  , "RESULT TY:\n" <> prettyStr (expTy id result)
-                  ]
-          doTraceM "addTypeAbstractions" msg
-          pure result
+          pure $ foldr TyAbs e' bvars
 
 -- sorry koz. in my heart i know you're right about type synonyms, but...
 type InlineState a = State (Map (Ident, Int) InlineBodyData) a
@@ -234,26 +212,14 @@ handleSelfRecursive (nm, indx) body
       pure $ M.fromList [updatedOriginalDecl, newBreakerDecl]
 
 inlineWithData :: MonoExp -> InlineState MonoExp
-inlineWithData = transformM go''
+inlineWithData = transformM go
   where
-    go'' ex = do
-      res <- go ex
-      let msg = prettify ["INPUT:\n" <> prettyStr ex, "RESULT:\n" <> prettyStr res]
-      doTraceM "inlineWithData" msg
-      pure res
     go :: MonoExp -> InlineState MonoExp
     go ex =
       get >>= \dict -> case ex of
         fv@(V (F {})) -> case toHole fv of
           Just (Hole hId hIx _) -> case M.lookup (hId, hIx) dict of
-            Just (NotALoopBreaker (toExp -> e)) -> do
-              let msg =
-                    prettify
-                      [ "INPUT:\n" <> prettyStr fv
-                      , "RESULT:\n" <> prettyStr e
-                      ]
-              doTraceM "inlineWithData" msg
-              pure e
+            Just (NotALoopBreaker (toExp -> e)) -> pure e
             _ -> pure fv
           _ -> pure fv
         V b@B {} -> pure $ V b
@@ -280,26 +246,8 @@ doneInlining :: MonoExp -> InlineState Bool
 doneInlining me = do
   dct <- get
   let allInlineable = M.keysSet $ M.filter notALoopBreaker dct
-      allHoles = S.fromList $ mapMaybe (fmap unHole . toHole) (me ^.. cosmos)
-      result = S.null $ S.intersection allHoles allInlineable
-      msg =
-        prettify
-          [ "Input Expr:\n" <> prettyStr me
-          , "All Inlineable Vars:\n" <> prettyStr (S.toList allInlineable)
-          , "All Holes in expr:\n" <> prettyStr (S.toList allHoles)
-          , "Not yet inlined:\n" <> prettyStr (S.toList $ S.intersection allHoles allInlineable)
-          , "Are we done?: " <> show result
-          ]
-  doTraceM "doneInlining" msg
-  pure result
-
-prettyDict :: Map (Ident, Int) InlineBodyData -> String
-prettyDict =
-  show
-    . align
-    . vcat
-    . map (\((i, n), b) -> pretty (runIdent i) <+> "#" <+> pretty n <+> "=" <+> pretty (toExp $ getInlineBody b) <+> hardline)
-    . M.toList
+  let allHoles = S.fromList $ mapMaybe (fmap unHole . toHole) (me ^.. cosmos)
+  pure . S.null $ S.intersection allHoles allInlineable
 
 inlineInLifted :: [MonoBind] -> Inline (Map (Ident, Int) InlineBodyData)
 inlineInLifted decls = do
@@ -313,19 +261,12 @@ inlineInLifted decls = do
           )
           M.empty
           decls
-  let res = flip execState dict $ update [] (M.keys dict)
-      msg = prettify ["Input:\n" <> prettyStr decls, "Result:\n" <> prettyDict res, "Breakers:\n" <> prettyStr (S.toList breakers)]
-  doTraceM "inlineLifted" msg
-  pure res
+  pure . flip execState dict $ update [] (M.keys dict)
   where
     update :: [(Ident, Int)] -> [(Ident, Int)] -> InlineState ()
     update [] [] = pure ()
-    update retry [] = do
-      let msg = "RETRY:\n" <> prettyStr retry
-      doTraceM "update" msg
-      update [] retry
+    update retry [] = update [] retry
     update retry (i : is) = do
-      doTraceM "update" (prettify ["GO", "RETRY STACK:\n" <> prettyStr retry, "ACTIVE STACK:\n" <> prettyStr (i : is)])
       s <- get
       let e = s M.! i
       done1 <- doneInlining . toExp . getInlineBody $ e
@@ -378,18 +319,14 @@ inlineInLifted decls = do
     breakLoops ::
       AdjacencyMap (Ident, Int) ->
       Set LoopBreaker
-    breakLoops adjMap = doTrace "breakLoops" msg result
+    breakLoops = evalState breakEm
       where
-        result = evalState breakEm adjMap
-        msg = "RESULT:\n" <> prettyStr (S.toList result)
-
         breakEm :: State (AdjacencyMap (Ident, Int)) (Set LoopBreaker)
         breakEm = do
           adjaMap <- get
           let stronglyConnected = gmap fromNonEmpty $ scc adjaMap
               revTopoSorted :: [AdjacencyMap (Ident, Int)]
               revTopoSorted = reverse $ either cycleErr id $ topSort stronglyConnected
-          doTraceM "breakEm" ("RevTopoSorted:\n" <> prettyStr (vertexList <$> revTopoSorted))
           case find nonTrivialGroup revTopoSorted of
             Nothing -> pure S.empty
             Just target -> do
diff --git a/src/Language/Purus/Pipeline/Instantiate.hs b/src/Language/Purus/Pipeline/Instantiate.hs
index c8e4c70a..947f2953 100644
--- a/src/Language/Purus/Pipeline/Instantiate.hs
+++ b/src/Language/Purus/Pipeline/Instantiate.hs
@@ -20,7 +20,6 @@ import Language.PureScript.CoreFn.TypeLike (TypeLike (..), instantiates)
 import Language.PureScript.Names (Ident (Ident))
 import Language.PureScript.Types (Type (..))
 
-import Language.Purus.Debug (doTrace, prettify)
 import Language.Purus.IR (BVar (..), Exp (..), analyzeApp, expTy)
 import Language.Purus.IR.Utils (
   Vars,
@@ -30,7 +29,6 @@ import Language.Purus.IR.Utils (
   transformTypesInExp,
   viaExp,
  )
-import Language.Purus.Pretty.Common (prettyStr)
 
 import Control.Lens (transform, view, _2)
 import Prettyprinter (Pretty)
@@ -44,7 +42,7 @@ applyPolyRowArgs ::
   Exp WithObjects PurusType (Vars PurusType) ->
   Exp WithObjects PurusType (Vars PurusType)
 applyPolyRowArgs = transform $ \case
-  instE@(TyInstE t (TyAbs (BVar kvI kvTy (Ident kvNm)) innerE)) -> case kvTy of
+  instE@(TyInstE t (TyAbs (BVar _ kvTy (Ident kvNm)) innerE)) -> case kvTy of
     TypeApp _ (TypeConstructor _ C.Row) _ -> transformTypesInExp (replaceAllTypeVars [(kvNm, t)]) innerE
     _ -> instE
   other -> other
@@ -67,7 +65,7 @@ instantiateTypes = \case
   TyAbs t inner -> TyAbs t (instantiateTypes inner)
   TyInstE t inner -> TyInstE t (instantiateTypes inner)
 
-instantiateApp :: forall x (t :: *). (Pretty t, TypeLike t, Pretty (KindOf t)) => Exp x t (Vars t) -> Exp x t (Vars t)
+instantiateApp :: forall x (t :: *). (Pretty t, TypeLike t) => Exp x t (Vars t) -> Exp x t (Vars t)
 instantiateApp e = case analyzeApp e of
   Nothing -> e
   Just (f, args) ->
@@ -77,18 +75,7 @@ instantiateApp e = case analyzeApp e of
         quantifiedTyVars = view _2 <$> fTyVars
         instantiations = getInstantiations quantifiedTyVars fTypes argTypes
         f' = go instantiations quantifiedTyVars f
-        msg =
-          prettify
-            [ "Function:\n" <> prettyStr f
-            , "Arguments:\n" <> prettyStr args
-            , "Split Fun Types:\n" <> prettyStr fTypes
-            , "Split Arg Types:\n" <> prettyStr argTypes
-            , "Quantified TyVars:\n" <> prettyStr quantifiedTyVars
-            , "Instantiations:\n" <> prettyStr (M.toList instantiations)
-            , "New Function:\n" <> prettyStr f'
-            , "New Function Type:\n" <> prettyStr (expTy id f')
-            ]
-     in doTrace "instantiateTypes" msg $ foldl' AppE f' args
+     in foldl' AppE f' args
   where
     go :: Map Text t -> [Text] -> Exp x t (Vars t) -> Exp x t (Vars t)
     go _ [] ex = ex
diff --git a/src/Language/Purus/Pipeline/Lift.hs b/src/Language/Purus/Pipeline/Lift.hs
index 083d3c8b..1ac58dca 100644
--- a/src/Language/Purus/Pipeline/Lift.hs
+++ b/src/Language/Purus/Pipeline/Lift.hs
@@ -16,10 +16,6 @@ import Language.PureScript.CoreFn.TypeLike (
  )
 import Language.PureScript.Names (Ident (..), runIdent)
 import Language.PureScript.PSString (PSString)
-import Language.Purus.Debug (
-  doTraceM,
-  prettify,
- )
 import Language.Purus.IR (
   Alt (..),
   BVar (..),
@@ -60,7 +56,7 @@ import Language.Purus.Pipeline.Lift.Types (
   pattern LiftedHoleTerm,
  )
 import Language.Purus.Pipeline.Monad (Inline, MonadCounter (next))
-import Language.Purus.Pretty.Common (docString, prettyStr)
+import Language.Purus.Pretty.Common (prettyStr)
 
 import Control.Applicative (Alternative ((<|>)))
 
@@ -75,23 +71,13 @@ import Data.Set qualified as S
 
 import Control.Monad.Reader (asks, foldM)
 
-import Debug.Trace (trace)
-
 import Data.Text qualified as T
 
-import Control.Lens (cosmos, over, toListOf, transform, (^..), _1)
+import Control.Lens (cosmos, over, transform, (^..), _1)
 
 import Bound.Scope (abstract)
 import Bound.Var (Var (..))
 
-import Prettyprinter (
-  Pretty (pretty),
-  align,
-  hardline,
-  indent,
-  vcat,
- )
-
 {- Given a collection of declarations that will be lifted, determine for each declaration
    the "deep" (recursive) set of NEW variable dependencies which need to be added
    as additional arguments.
@@ -225,15 +211,6 @@ updateAllBinds deepDict prunedBody _binds = do
 
       binds = mapBind go <$> _binds
 
-      msg =
-        prettify
-          [ "Pruned body:\n " <> prettyStr prunedBody
-          , "AllDeclIdents:\n " <> prettyStr allLiftedIdents
-          , "AdjustedBody:\n " <> prettyStr adjustedBody
-          , "Binds:\n" <> concatMap (\x -> prettyStr x <> "\n\n") binds
-          , "Deep Dict:\n" <> prettyStr (M.toList (S.toList <$> deepDict))
-          ]
-  doTraceM "updateAllBinds" msg
   pure (binds, adjustedBody)
   where
     coerceOldToNew ::
@@ -347,22 +324,11 @@ lift mainNm _e = do
   e <- handleSelfRecursiveMain
   modDict <- mkModDict
   let collectDict = mkDict S.empty modDict e
-      prettyCollectDict = docString . indent 2 . align . vcat $ map (\((nm, indx), b) -> pretty nm <> "#" <> pretty indx <> pretty (toExp b) <> hardline) (M.toList collectDict)
       (toLift, prunedExp, _) = collect S.empty collectDict S.empty S.empty e
       deepDict = deepAnalysis toLift
       liftThese = S.toList . S.unions $ declarations <$> S.toList toLift
   (binds, body) <- updateAllBinds deepDict prunedExp liftThese
-  result <- cleanupLiftedTypes $ LiftResult binds body
-  let msg =
-        prettify
-          [ "Input Expr:\n" <> prettyStr e
-          , "Pruned Expr:\n" <> prettyStr prunedExp
-          , "ToLifts:\n" <> prettyStr (S.toList toLift)
-          , "Collect Dict:\n" <> prettyCollectDict
-          , "Result\n" <> prettyStr result
-          ]
-  doTraceM "lift" msg
-  pure result
+  cleanupLiftedTypes $ LiftResult binds body
   where
     handleSelfRecursiveMain :: Inline MonoExp
     handleSelfRecursiveMain
@@ -395,7 +361,7 @@ lift mainNm _e = do
       Map (Ident, Int) MonoScoped ->
       MonoExp ->
       Map (Ident, Int) MonoScoped
-    mkDict visited acc me = trace "mkDict" $ case me of
+    mkDict visited acc me = case me of
       V F {} -> acc
       (V (B (BVar bvIx _ bvId))) -> case S.member (bvId, bvIx) visited of
         True -> acc
@@ -426,7 +392,7 @@ lift mainNm _e = do
       Set (BVar (KindOf PurusType)) ->
       MonoExp ->
       (Set ToLift, MonoExp, Set (Ident, Int))
-    collect visited dict boundVars boundTyVars me = trace "collect" $ case me of
+    collect visited dict boundVars boundTyVars me = case me of
       -- we ignore free variables. For us, a free variable more or less represents "shouldn't/can't be inlined"
       V fv@F {} -> (S.empty, V fv, visited)
       V b@(B (BVar bvIx (stripSkolems -> bvTy) bvIdent)) -> case M.lookup (bvIdent, bvIx) dict of
@@ -498,7 +464,7 @@ lift mainNm _e = do
           Set (BVar (KindOf PurusType)) ->
           [MonoBind] ->
           (Set ToLift, Set (Ident, Int))
-        collectFromNestedDeclarations vis termBound typeBound liftThese = trace "collectFromNested" $ foldBinds go (S.empty, vis) liftThese
+        collectFromNestedDeclarations vis termBound typeBound liftThese = foldBinds go (S.empty, vis) liftThese
           where
             go :: (Set ToLift, Set (Ident, Int)) -> (Ident, Int) -> MonoScoped -> (Set ToLift, Set (Ident, Int))
             go (liftAcc, visAcc) (nm, indx) scoped =
diff --git a/src/Language/Purus/Utils.hs b/src/Language/Purus/Utils.hs
index e8e6ed6d..949b4d63 100644
--- a/src/Language/Purus/Utils.hs
+++ b/src/Language/Purus/Utils.hs
@@ -17,7 +17,6 @@ import Language.PureScript.Names (
   pattern ByNullSourcePos,
  )
 
-import Language.Purus.Debug (doTrace)
 import Language.Purus.IR (BVar, BindE (..), Exp)
 import Language.Purus.IR.Utils (IR_Decl, Vars, WithObjects, foldBinds, toExp)
 
@@ -60,7 +59,7 @@ findMain ::
   Text ->
   Module IR_Decl k PurusType Ann ->
   Maybe ((Ident, Int), Scope (BVar PurusType) (Exp WithObjects PurusType) (Vars PurusType))
-findMain nm Module {..} = doTrace "findDeclBody" ("NAME: " <> T.unpack nm) $ findMain' (Ident nm) moduleDecls
+findMain nm Module {..} = findMain' (Ident nm) moduleDecls
 
 findMain' ::
   forall x ty.

From 4e903fafe337dba78c09676320fd75b5ccb4da52 Mon Sep 17 00:00:00 2001
From: Koz Ross <koz.ross@retro-freedom.nz>
Date: Fri, 6 Sep 2024 14:36:18 +1200
Subject: [PATCH 2/2] Remove remaining traces

---
 src/Language/PureScript/CST/Convert.hs        |  12 +-
 src/Language/PureScript/CoreFn/Desugar.hs     |  55 ++-------
 .../PureScript/CoreFn/Desugar/Utils.hs        |  30 ++---
 src/Language/PureScript/CoreFn/TypeLike.hs    |  15 +--
 src/Language/PureScript/Make.hs               |   3 -
 .../PureScript/Sugar/CaseDeclarations.hs      |   1 -
 src/Language/PureScript/TypeChecker/Kinds.hs  | 107 +++---------------
 .../PureScript/TypeChecker/Subsumption.hs     |  26 +----
 src/Language/PureScript/TypeChecker/Types.hs  |   9 +-
 src/Language/PureScript/TypeChecker/Unify.hs  |   9 +-
 10 files changed, 46 insertions(+), 221 deletions(-)

diff --git a/src/Language/PureScript/CST/Convert.hs b/src/Language/PureScript/CST/Convert.hs
index 9e686816..290b076a 100644
--- a/src/Language/PureScript/CST/Convert.hs
+++ b/src/Language/PureScript/CST/Convert.hs
@@ -22,7 +22,7 @@ import Control.Monad.State
 import Data.Bifunctor (bimap, first, second)
 import Data.Bitraversable (Bitraversable (..))
 import Data.Char (toLower)
-import Data.Foldable (foldl', foldrM, toList, traverse_)
+import Data.Foldable (foldrM, toList, traverse_)
 import Data.Functor (($>))
 import Data.List.NonEmpty qualified as NE
 import Data.Map (Map)
@@ -46,7 +46,6 @@ import Language.PureScript.PSString (mkString, prettyPrintStringJS)
 import Language.PureScript.Types qualified as T
 
 import Data.List (partition)
-import Debug.Trace (trace)
 
 type ConvertM a = State (Map Text T.SourceType) a
 
@@ -82,11 +81,10 @@ srcTokenRange = tokRange . tokAnn
    type signature in scope when we convert the declaration.
 
 -}
-groupSignaturesAndDeclarations :: (Show a) => [Declaration a] -> [[Declaration a]]
+groupSignaturesAndDeclarations :: [Declaration a] -> [[Declaration a]]
 groupSignaturesAndDeclarations [] = []
 groupSignaturesAndDeclarations decls =
-  trace ("DECLARATIONS (grouping): \n" <> concatMap ((<> "\n\n") . show) decls) $
-    go kindSigs typeSigs decls'
+  go kindSigs typeSigs decls'
   where
     ((kindSigs, typeSigs), decls') =
       foldr
@@ -239,7 +237,7 @@ convertType' withinVta fileName = go
       TypeForall _ kw bindings _ ty -> do
         -- TODO: Refactor this (if it works)
         let
-          doBind (TypeVarKinded (Wrapped _ (Labeled (v, a) _ b) _)) = do
+          doBind (TypeVarKinded (Wrapped _ (Labeled (_, a) _ b) _)) = do
             let nm = getIdent (nameValue a)
             b' <- go b
             bindTv nm b'
@@ -255,7 +253,7 @@ convertType' withinVta fileName = go
             bindTv nm b'
             pure $ mkForAll a b' v t
           -- TODO: Fix this better
-          k (TypeVarName (v, a)) t = internalError $ "Error: Universally quantified type variable without kind annotation: " <> (Text.unpack . getIdent . nameValue $ a) <> "\nat: " <> show v
+          k (TypeVarName (v, a)) _ = internalError $ "Error: Universally quantified type variable without kind annotation: " <> (Text.unpack . getIdent . nameValue $ a) <> "\nat: " <> show v
         traverse_ doBind bindings
         inner <- go ty
         ty' <- foldrM k inner bindings
diff --git a/src/Language/PureScript/CoreFn/Desugar.hs b/src/Language/PureScript/CoreFn/Desugar.hs
index 295050fe..ed97a1eb 100644
--- a/src/Language/PureScript/CoreFn/Desugar.hs
+++ b/src/Language/PureScript/CoreFn/Desugar.hs
@@ -3,7 +3,7 @@
 
 module Language.PureScript.CoreFn.Desugar (moduleToCoreFn) where
 
-import Protolude (Bifunctor (bimap), MonadError (..), orEmpty, ordNub, sortOn, zipWithM)
+import Protolude (MonadError (..), orEmpty, ordNub, sortOn, zipWithM)
 import Prelude
 
 import Data.Foldable (foldl')
@@ -12,15 +12,13 @@ import Data.List.NonEmpty qualified as NEL
 import Data.Map qualified as M
 import Data.Maybe (mapMaybe)
 
-import Control.Monad (foldM, forM, (<=<), (>=>))
+import Control.Monad (foldM, forM, (>=>))
 import Control.Monad.State.Strict (MonadState, gets, modify)
 import Control.Monad.Writer.Class (MonadWriter)
 import Data.Either (lefts)
 import Data.List.NonEmpty qualified as NE
 import Data.Set qualified as S
 import Data.Text qualified as T
-import Data.Text.Lazy qualified as LT
-import Debug.Trace (traceM)
 import Language.PureScript.AST.Binders qualified as A
 import Language.PureScript.AST.Declarations qualified as A
 import Language.PureScript.AST.Literals (Literal (..))
@@ -75,7 +73,6 @@ import Language.PureScript.Environment (
   NameVisibility (..),
   function,
   isDictTypeName,
-  lookupConstructor,
   lookupValue,
   tyBoolean,
   tyChar,
@@ -129,7 +126,7 @@ import Language.PureScript.Types (
   rowToList,
   pattern REmptyKinded,
  )
-import Language.Purus.Pretty (ppType, prettyDatatypes, prettyStr, renderExprStr)
+import Language.Purus.Pretty (ppType)
 import Prettyprinter (Pretty (pretty))
 
 {-
@@ -162,8 +159,7 @@ moduleToCoreFn (A.Module modSS coms mn _decls (Just exps)) = do
   decls' <- concat <$> traverse (declToCoreFn mn) nonDataDecls
   let dataDecls' = mkDataDecls mn dataDecls
       result = Module modSS coms mn (spanName modSS) imports exps' reExps externs decls' dataDecls'
-  traceM $ prettyStr dataDecls'
-  pure $ result
+  pure result
   where
     setModuleName = modify $ \cs ->
       cs {checkCurrentModule = Just mn}
@@ -214,12 +210,8 @@ lookupType sp tn = do
   case M.lookup (Qualified (BySourcePos sp) tn) (names env) of
     Nothing -> case M.lookup (mkQualified tn mn) (names env) of
       Nothing -> error $ "No type found for " <> show tn
-      Just (ty, _, nv) -> do
-        traceM $ "lookupType: " <> showIdent' tn <> " :: " <> ppType 10 ty
-        pure (ty, nv)
-    Just (ty, _, nv) -> do
-      traceM $ "lookupType: " <> showIdent' tn <> " :: " <> ppType 10 ty
-      pure (ty, nv)
+      Just (ty, _, nv) -> pure (ty, nv)
+    Just (ty, _, nv) -> pure (ty, nv)
 
 getInnerListTy :: Type a -> Maybe (Type a)
 getInnerListTy (ListT arr) = Just arr
@@ -234,7 +226,6 @@ getInnerObjectTy _ = Nothing
 
 objectToCoreFn :: forall m. (M m) => ModuleName -> SourceSpan -> SourceType -> SourceType -> [(PSString, A.Expr)] -> m (Expr Ann)
 objectToCoreFn mn ss recTy row objFields = do
-  traceM $ "ObjLitTy: " <> show row
   let (tyFields, _) = rowToList row
       tyMap = M.fromList $ (\x -> (runLabel (rowListLabel x), x)) <$> tyFields
   resolvedFields <- foldM (go tyMap) [] objFields
@@ -273,7 +264,7 @@ declToCoreFn _ (A.DataDeclaration (ss, com) Newtype name _ [ctor]) = wrapTrace (
 declToCoreFn _ d@(A.DataDeclaration _ Newtype _ _ _) =
   error $ "Found newtype with multiple constructors: " ++ show d
 -- Data declarations shouldn't exist here
-declToCoreFn mn (A.DataDeclaration (ss, com) Data tyName _ ctors) =
+declToCoreFn mn (A.DataDeclaration (_, _) Data tyName _ _) =
   error $
     "declToCoreFn: INTERNAL ERROR. Encountered a data declaration in module "
       <> show (pretty mn)
@@ -286,9 +277,7 @@ declToCoreFn mn (A.DataBindingGroupDeclaration ds) = wrapTrace "declToCoreFn DAT
 -- Essentially a wrapper over `exprToCoreFn`. Not 100% sure if binding the type of the declaration is necessary here?
 -- NOTE: Should be impossible to have a guarded expr here, make it an error
 declToCoreFn mn (A.ValueDecl (ss, _) name _ _ [A.MkUnguarded e]) = wrapTrace ("decltoCoreFn VALDEC " <> show name) $ do
-  traceM $ renderValue 100 e
   (valDeclTy, nv) <- lookupType (spanStart ss) name
-  traceM (ppType 100 valDeclTy)
   bindLocalVariables [(ss, name, valDeclTy, nv)] $ do
     expr <- exprToCoreFn mn ss (Just valDeclTy) e -- maybe wrong? might need to bind something here?
     pure [NonRec (ssA ss) name expr]
@@ -318,7 +307,6 @@ exprToCoreFn :: forall m. (M m) => ModuleName -> SourceSpan -> Maybe SourceType
 exprToCoreFn mn ss (Just arrT) astlit@(A.Literal _ (ListLiteral ts))
   | Just ty <- getInnerListTy arrT =
       wrapTrace ("exprToCoreFn ARRAYLIT " <> renderValue 100 astlit) $ do
-        traceM $ ppType 100 arrT
         mkList ty <$> traverse (exprToCoreFn mn ss (Just ty)) ts
 exprToCoreFn _ _ Nothing astlit@(A.Literal _ (ListLiteral _)) =
   internalError $ "Error while desugaring List Literal. No type provided for literal:\n" <> renderValue 100 astlit
@@ -336,7 +324,7 @@ exprToCoreFn _ _ _ (A.Literal ss (NumericLiteral (Right number))) =
   pure $ Literal (ss, [], Nothing) tyNumber (NumericLiteral (Right number))
 exprToCoreFn _ _ _ (A.Literal ss (CharLiteral char)) =
   pure $ Literal (ss, [], Nothing) tyChar (CharLiteral char)
-exprToCoreFn _ _ _ (A.Literal ss (BooleanLiteral boolean)) =
+exprToCoreFn _ _ _ (A.Literal _ (BooleanLiteral boolean)) =
   if boolean then pure true else pure false
 exprToCoreFn _ _ _ (A.Literal ss (StringLiteral string)) =
   pure $ Literal (ss, [], Nothing) tyString (StringLiteral string)
@@ -430,25 +418,17 @@ exprToCoreFn _ _ t lam@(A.Abs _ _) =
 -}
 exprToCoreFn mn ss mTy app@(A.App fun arg)
   | isDictCtor fun = wrapTrace "exprToCoreFn APP DICT " $ do
-      traceM $ "APP Dict type" <> show (ppType 100 <$> mTy)
-      traceM $ "APP Dict expr:\n" <> renderValue 100 app
       let analyzed = mTy >>= analyzeCtor
-          prettyAnalyzed = bimap (ppType 100) (fmap (ppType 100)) <$> analyzed
-      traceM $ "APP DICT analyzed:\n" <> show prettyAnalyzed
       case mTy of
         Just iTy ->
           case analyzed of
             -- Branch for a "normal" (i.e. non-empty) typeclass dictionary application
             Just (TypeConstructor _ (Qualified qb nm), args) -> do
-              traceM $ "APP Dict name: " <> T.unpack (runProperName nm)
               env <- getEnv
               case M.lookup (Qualified qb $ coerceProperName nm) (dataConstructors env) of
                 Just (_, _, ty, _) -> do
-                  traceM $ "APP Dict original type:\n" <> ppType 100 ty
                   case instantiate ty args of
-                    iFun@(iArg :-> iRes) -> do
-                      traceM $ "APP Dict iArg:\n" <> ppType 100 iArg
-                      traceM $ "APP Dict iRes:\n" <> ppType 100 iRes
+                    iFun@(iArg :-> _) -> do
                       fun' <- exprToCoreFn mn ss (Just iFun) fun
                       arg' <- exprToCoreFn mn ss (Just iArg) arg
                       pure $ App (ss, [], Nothing) fun' arg'
@@ -467,12 +447,8 @@ exprToCoreFn mn ss mTy app@(A.App fun arg)
                 _ -> error "An application desguared to something else. This should not be possible."
         Nothing -> error $ "APP Dict w/o type passed in (impossible to infer):\n" <> renderValue 100 app
   | otherwise = wrapTrace "exprToCoreFn APP" $ do
-      traceM $ renderValue 100 app
       fun' <- exprToCoreFn mn ss Nothing fun
-      let funTy = exprType fun'
-      traceM $ "app fun:\n" <> ppType 100 funTy <> "\n" <> renderExprStr fun'
       arg' <- exprToCoreFn mn ss Nothing arg -- We want to keep the original "concrete" arg type
-      traceM $ "app arg:\n" <> ppType 100 (exprType arg') <> "\n" <> renderExprStr arg'
       pure $ App (ss, [], Nothing) fun' arg'
   where
     isDictCtor = \case
@@ -497,7 +473,7 @@ exprToCoreFn _ _ _ (A.Var ss ident) =
         lookupDictType ident >>= \case
           Just ty -> pure $ Var (ss, [], getValueMeta env ident) (purusTy ty) ident
           Nothing -> internalError $ "No known type for identifier " <> show ident
-exprToCoreFn _ _ mty expr@(A.Var ss ident) =
+exprToCoreFn _ _ mty expr@(A.Var _ _) =
   internalError $
     "Internal compiler error (exprToCoreFn var fail): Cannot synthesize type for var "
       <> show expr
@@ -549,9 +525,7 @@ exprToCoreFn _ _ Nothing ctor@(A.Constructor _ _) =
          complexity (machinery is complicated) and would not be good for performance (typechecking
          and inference have bad complexity).
 -}
-exprToCoreFn mn ss (Just caseTy) astCase@(A.Case vs alts) = wrapTrace "exprToCoreFn CASE" $ do
-  traceM $ "CASE:\n" <> renderValue 100 astCase
-  traceM $ "CASE TY:\n" <> show (ppType 100 caseTy)
+exprToCoreFn mn ss (Just caseTy) (A.Case vs alts) = wrapTrace "exprToCoreFn CASE" $ do
   (vs', ts) <- unzip <$> traverse (exprToCoreFn mn ss Nothing >=> (\e -> pure (e, exprType e))) vs -- extract type information for the *scrutinees*
   alts' <- traverse (altToCoreFn mn ss caseTy ts) alts -- see explanation in altToCoreFn. We pass in the types of the scrutinee(s)
   pure $ Case (ssA ss) (purusTy caseTy) vs' alts'
@@ -559,8 +533,6 @@ exprToCoreFn mn ss Nothing astCase@(A.Case vs alts@(alt : _)) = wrapTrace "exprT
   case alt of
     A.CaseAlternative _ (A.GuardedExpr _ body1 : _) -> do
       caseTy <- exprType <$> exprToCoreFn mn ss Nothing body1
-      traceM $ "CASE:\n" <> renderValue 100 astCase
-      traceM $ "CASE TY:\n" <> show (ppType 100 caseTy)
       (vs', ts) <- unzip <$> traverse (exprToCoreFn mn ss Nothing >=> (\e -> pure (e, exprType e))) vs -- extract type information for the *scrutinees*
       alts' <- traverse (altToCoreFn mn ss caseTy ts) alts -- see explanation in altToCoreFn. We pass in the types of the scrutinee(s)
       pure $ Case (ssA ss) (purusTy caseTy) vs' alts'
@@ -698,16 +670,12 @@ inferBinder' _ (A.LiteralBinder _ (NumericLiteral (Right _))) = wrapTrace "infer
 inferBinder' _ (A.LiteralBinder _ (BooleanLiteral _)) = wrapTrace "inferBinder' BOOLLIT" $ return M.empty
 inferBinder' val (A.VarBinder ss name) = wrapTrace ("inferBinder' VAR " <> T.unpack (runIdent name)) $ return $ M.singleton name (ss, val)
 inferBinder' val (A.ConstructorBinder ss ctor binders) = wrapTrace ("inferBinder' CTOR: " <> show ctor) $ do
-  traceM $ "InferBinder VAL:\n" <> ppType 100 val
   env <- getEnv
   let cArgs = ctorArgs val
-  traceM $ "InferBinder CTOR ARGS:\n" <> concatMap (\x -> ppType 100 x <> "\n") cArgs
   case M.lookup ctor (dataConstructors env) of
     Just (_, _, _ty, _) -> do
       let ty = instantiate _ty cArgs
-      traceM $ "InferBinder CTOR TY:\n" <> ppType 100 ty
       let (args, _) = peelArgs ty
-      traceM $ "InferBinder ARGS:\n" <> concatMap (\x -> ppType 100 x <> "\n") args
       M.unions <$> zipWithM inferBinder' (reverse args) binders
     _ -> throwError . errorMessage' ss . UnknownName . fmap DctorName $ ctor
   where
@@ -717,7 +685,6 @@ inferBinder' val (A.ConstructorBinder ss ctor binders) = wrapTrace ("inferBinder
         go args (TypeApp _ (TypeApp _ fn arg) ret) | eqType fn tyFunction = go (arg : args) ret
         go args ret = (args, ret)
 inferBinder' val (A.LiteralBinder _ (ObjectLiteral props)) = wrapTrace "inferBinder' OBJECTLIT" $ do
-  traceM $ ppType 100 val
   let props' = sortOn fst props
   case unwrapRecord val of
     Left notARecord ->
diff --git a/src/Language/PureScript/CoreFn/Desugar/Utils.hs b/src/Language/PureScript/CoreFn/Desugar/Utils.hs
index 3672c62a..93803b3e 100644
--- a/src/Language/PureScript/CoreFn/Desugar/Utils.hs
+++ b/src/Language/PureScript/CoreFn/Desugar/Utils.hs
@@ -5,7 +5,7 @@
 
 module Language.PureScript.CoreFn.Desugar.Utils where
 
-import Protolude (MonadError (..), traverse_)
+import Protolude (MonadError (..))
 import Prelude
 
 import Data.Function (on)
@@ -20,7 +20,6 @@ import Data.Bifunctor (Bifunctor (..))
 import Data.List (foldl')
 import Data.List.NonEmpty qualified as NEL
 import Data.Text qualified as T
-import Debug.Trace (trace, traceM)
 import Language.PureScript.AST qualified as A
 import Language.PureScript.AST.Declarations (declSourceSpan)
 import Language.PureScript.AST.Literals (Literal (..))
@@ -61,7 +60,6 @@ import Language.PureScript.Sugar (desugarGuardedExprs)
 import Language.PureScript.TypeChecker.Monad (
   CheckState (checkCurrentModule, checkEnv),
   bindLocalVariables,
-  debugNames,
   getEnv,
   withScopedTypeVars,
  )
@@ -271,9 +269,7 @@ unwrapRecord = \case
     go RowListItem {..} = (runLabel rowListLabel, rowListType)
 
 traceNameTypes :: (M m) => m ()
-traceNameTypes = do
-  nametypes <- getEnv >>= pure . debugNames
-  traverse_ traceM nametypes
+traceNameTypes = pure ()
 
 desugarCasesEverywhere :: (M m) => A.Declaration -> m A.Declaration
 desugarCasesEverywhere d = traverseDeclBodies (transformM $ desugarGuardedExprs (declSourceSpan d)) d
@@ -402,21 +398,12 @@ desugarConstraintsInDecl = \case
   other -> other
 
 -- TODO: Remove this 
-pTrace :: (Monad m, Show a) => a -> m ()
-pTrace = traceM . show
+pTrace :: (Monad m) => a -> m ()
+pTrace _ = pure ()
 
 -- | Given a string and a monadic action, produce a trace with the given message before & after the action (with pretty lines to make it more readable)
-wrapTrace :: (Monad m) => String -> m a -> m a
-wrapTrace msg act = do
-  traceM startMsg
-  res <- act
-  traceM endMsg
-  pure res
-  where
-    padding = replicate 10 '='
-    pad str = padding <> str <> padding
-    startMsg = pad $ "BEGIN " <> msg
-    endMsg = pad $ "END " <> msg
+wrapTrace :: String -> m a -> m a
+wrapTrace _ act = act
 
 {-
   This is used to solve a problem that arises with re-exported instances.
@@ -639,9 +626,8 @@ binderToCoreFn dict env mn _ss (A.LiteralBinder ss lit) =
    in LiteralBinder (ss, [], Nothing) lit'
 binderToCoreFn _ _ _ ss A.NullBinder =
   NullBinder (ss, [], Nothing)
-binderToCoreFn dict _ _ _ss vb@(A.VarBinder ss name) =
-  trace ("binderToCoreFn: " <> show vb) $
-    VarBinder (ss, [], Nothing) name (dict M.! name)
+binderToCoreFn dict _ _ _ss (A.VarBinder ss name) =
+  VarBinder (ss, [], Nothing) name (dict M.! name)
 binderToCoreFn dict env mn _ss (A.ConstructorBinder ss dctor@(Qualified mn' _) bs) =
   let (_, tctor, _, _) = lookupConstructor env dctor
       args = binderToCoreFn dict env mn _ss <$> bs
diff --git a/src/Language/PureScript/CoreFn/TypeLike.hs b/src/Language/PureScript/CoreFn/TypeLike.hs
index 30c32c40..c1c6a1cb 100644
--- a/src/Language/PureScript/CoreFn/TypeLike.hs
+++ b/src/Language/PureScript/CoreFn/TypeLike.hs
@@ -12,10 +12,8 @@ import Control.Applicative
 import Control.Lens.Operators ((<&>))
 import Data.Kind qualified as GHC
 import Data.Maybe (catMaybes)
-import Debug.Trace (trace)
 import Language.PureScript.AST.SourcePos (pattern NullSourceAnn)
 import Language.PureScript.Environment (pattern RecordT, pattern (:->))
-import Language.Purus.Debug (doTrace)
 import Language.Purus.Pretty.Common
 import Prettyprinter (Pretty)
 
@@ -98,17 +96,8 @@ getInstantiations mono poly = catMaybes mInstantiations
     mInstantiations = freeInPoly <&> \nm -> (nm,) <$> instantiates nm mono poly
 
 instantiateWithArgs :: forall t. (TypeLike t, Pretty t) => t -> [t] -> t
-instantiateWithArgs f args = doTrace "instantiateWithArgs" msg result
+instantiateWithArgs f args = result 
   where
-    msg =
-      "instantiateWithArgs:\n  fun: "
-        <> prettyStr f
-        <> "\n  args: "
-        <> prettyStr args
-        <> "\n  instantiations: "
-        <> prettyStr instantiations
-        <> "\n  result: "
-        <> prettyStr result
     result = quantify $ replaceAllTypeVars instantiations (unQuantify f)
     instantiations = getAllInstantiations f args
 
@@ -118,7 +107,7 @@ getAllInstantiations ::
   t ->
   [t] ->
   [(Text, t)]
-getAllInstantiations fun args@(_ : _) = doTrace "getAllInstantiations" (prettyStr result) result
+getAllInstantiations fun args@(_ : _) = result
   where
     result = catMaybes $ zipWith go funArgs args
 
diff --git a/src/Language/PureScript/Make.hs b/src/Language/PureScript/Make.hs
index fc3b5ca0..d5179141 100644
--- a/src/Language/PureScript/Make.hs
+++ b/src/Language/PureScript/Make.hs
@@ -55,7 +55,6 @@ import System.Directory (doesFileExist)
 import System.FilePath (replaceExtension)
 
 -- Temporary
-import Debug.Trace (traceM)
 import Language.Purus.Pretty (ppType)
 
 initEnvironmentPurus :: Environment
@@ -129,11 +128,9 @@ rebuildModuleWithIndex MakeActions {..} exEnv externs m@(Module _ _ moduleName _
   regrouped <- createBindingGroups moduleName . collapseBindingGroups $ deguarded
 
   let mod' = Module ss coms moduleName regrouped exps
-  traceM $ "PURUS START HERE: " <> T.unpack (runModuleName moduleName)
   -- pTrace regrouped
   -- pTrace exps
   ((coreFn, chkSt'), nextVar'') <- runSupplyT nextVar' $ runStateT (CFT.moduleToCoreFn mod') chkSt -- (emptyCheckState env')
-  traceM . T.unpack $ CFT.prettyModuleTxt coreFn
   let corefn = coreFn
       (optimized, nextVar''') = runSupply nextVar'' $ CF.optimizeCoreFn corefn
       (renamedIdents, renamed) = renameInModule optimized
diff --git a/src/Language/PureScript/Sugar/CaseDeclarations.hs b/src/Language/PureScript/Sugar/CaseDeclarations.hs
index e186f464..ec0f51b1 100644
--- a/src/Language/PureScript/Sugar/CaseDeclarations.hs
+++ b/src/Language/PureScript/Sugar/CaseDeclarations.hs
@@ -26,7 +26,6 @@ import Language.PureScript.Errors (ErrorMessage (..), MultipleErrors (..), Simpl
 import Language.PureScript.Names (Ident (..), Qualified (..), freshIdent', pattern ByNullSourcePos)
 import Language.PureScript.TypeChecker.Monad (guardWith)
 
-import Debug.Trace
 import Language.PureScript.Types (SourceType, Type (TypeVar), quantify)
 
 {- |
diff --git a/src/Language/PureScript/TypeChecker/Kinds.hs b/src/Language/PureScript/TypeChecker/Kinds.hs
index ce862790..0d14054d 100644
--- a/src/Language/PureScript/TypeChecker/Kinds.hs
+++ b/src/Language/PureScript/TypeChecker/Kinds.hs
@@ -34,7 +34,6 @@ import Control.Monad.Error.Class (MonadError (..))
 import Control.Monad.State (MonadState, gets, modify)
 import Control.Monad.Supply.Class (MonadSupply (..))
 
-import Data.Bifunctor (first, second)
 import Data.Bitraversable (bitraverse)
 import Data.Foldable (for_, traverse_)
 import Data.Function (on)
@@ -42,12 +41,11 @@ import Data.Functor (($>))
 import Data.IntSet qualified as IS
 import Data.List (nubBy, sortOn, (\\))
 import Data.Map qualified as M
-import Data.Maybe (fromJust, fromMaybe)
+import Data.Maybe (fromJust)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Traversable (for)
 
-import Language.PureScript.CST.Types (Comment)
 import Language.PureScript.Crash (HasCallStack, internalError)
 import Language.PureScript.Environment qualified as E
 import Language.PureScript.Errors
@@ -58,68 +56,18 @@ import Language.PureScript.TypeChecker.Skolems (newSkolemConstant, newSkolemScop
 import Language.PureScript.TypeChecker.Synonyms (replaceAllTypeSynonyms)
 import Language.PureScript.Types
 
-import Data.Bifunctor (bimap)
-import Debug.Trace
-import Language.Purus.Pretty.Types (prettyTypeStr)
-
-moduleTraces :: Bool
-moduleTraces = True
-
-goTrace :: forall x. String -> x -> x
-goTrace str x
-  | moduleTraces = trace str x
-  | otherwise = x
-
-goTraceM :: forall f. (Applicative f) => String -> f ()
-goTraceM msg
-  | moduleTraces = traceM msg
-  | otherwise = pure ()
-
-spacer = '\n' : replicate 20 '-'
-prettySubstitution :: Substitution -> String
-prettySubstitution Substitution {..} =
-  "SUBSTITUTION: "
-    <> "\n SUBST_TYPE: "
-    <> show (bimap show prettyTypeStr <$> M.toList substType)
-    <> "\n SUBST_UNSOLVED: "
-    <> show (bimap show (bimap show prettyTypeStr) <$> M.toList substUnsolved)
-    <> "\n SUBST_NAMES: "
-    <> show (M.toList substNames)
+import Data.Bifunctor (first, second)
 
 -- TODO/REVIEW/HACK: -----------------------------------
 -- NO CLUE IF THE CHANGES I MADE HERE ARE CORRECT
 generalizeUnknowns :: [(Unknown, SourceType)] -> SourceType -> SourceType
 generalizeUnknowns unks ty =
-  goTrace msg $
-    generalizeUnknownsWithVars (unknownVarNames (fst <$> usedTypeVariables ty) unks) ty
-  where
-    result = generalizeUnknownsWithVars (unknownVarNames (fst <$> usedTypeVariables ty) unks) ty
-    msg =
-      "GENERALIZE UNKNOWNS:\nUNKNOWNS"
-        <> prettyUnknowns
-        <> "\n INPUT TYPE: "
-        <> prettyTypeStr ty
-        <> "\n OUTPUT TYPE: "
-        <> prettyTypeStr result
-        <> spacer
-    prettyUnknowns = concatMap (\x -> show (fst x) <> " :: " <> show (snd x) <> "\n") unks
+  generalizeUnknownsWithVars (unknownVarNames (fst <$> usedTypeVariables ty) unks) ty
 
 generalizeUnknownsWithVars :: [(Unknown, (Text, SourceType))] -> SourceType -> SourceType
 generalizeUnknownsWithVars binders ty =
-  goTrace msg $
-    mkForAll ((getAnnForType ty,) . fmap (replaceUnknownsWithVars binders) . snd <$> binders) . replaceUnknownsWithVars binders $
+  mkForAll ((getAnnForType ty,) . fmap (replaceUnknownsWithVars binders) . snd <$> binders) . replaceUnknownsWithVars binders $
       ty
-  where
-    prettyBinders :: [(Unknown, (Text, SourceType))] -> String
-    prettyBinders xs = concatMap (\x -> show (fst x) <> ", " <> T.unpack (fst (snd x)) <> " := " <> prettyTypeStr (snd (snd x)) <> "\n") xs
-
-    msg =
-      "GENERALIZE UNKNOWNS WITH VARS:"
-        <> "\n  UNKNOWNS: "
-        <> prettyBinders binders
-        <> "\n  TYPE: "
-        <> prettyTypeStr ty
-        <> spacer
 
 replaceUnknownsWithVars :: [(Unknown, (Text, SourceType))] -> SourceType -> SourceType
 replaceUnknownsWithVars binders ty
@@ -144,13 +92,7 @@ unknownVarNames used unks =
     vars = fmap (("k" <>) . T.pack . show) ([1 ..] :: [Int])
 
 apply :: (MonadState CheckState m) => SourceType -> m SourceType
-apply ty = goTrace msg $ flip substituteType ty <$> gets checkSubstitution
-  where
-    msg =
-      "APPLY"
-        <> "\n  TYPE: "
-        <> prettyTypeStr ty
-        <> spacer
+apply ty = flip substituteType ty <$> gets checkSubstitution
 
 substituteType :: Substitution -> SourceType -> SourceType
 substituteType sub = everywhereOnTypes $ \case
@@ -223,17 +165,7 @@ inferKind ::
 inferKind = \tyToInfer ->
   withErrorMessageHint (ErrorInferringKind tyToInfer)
     . rethrowWithPosition (fst $ getAnnForType tyToInfer)
-    $ do
-      result <- go tyToInfer
-      let msg =
-            "\nINFERKIND INPUT: "
-              <> prettyTypeStr tyToInfer
-              <> "\nINFERKIND RESULT: "
-              <> prettyTypeStr (snd result)
-              <> "\n"
-              <> replicate 20 '-'
-      goTraceM msg
-      pure result
+    $ go tyToInfer
   where
     go = \case
       ty@(TypeConstructor ann v) -> do
@@ -260,12 +192,12 @@ inferKind = \tyToInfer ->
         pure (ty, E.kindSymbol $> ann)
       ty@(TypeLevelInt ann _) ->
         pure (ty, E.tyInt $> ann)
-      ty@(TypeVar ann v kx) -> do
+      ty@(TypeVar ann _ kx) -> do
         -- moduleName <- unsafeCheckCurrentModule
         -- kind <- apply =<< lookupTypeVariable moduleName (Qualified ByNullSourcePos $ ProperName v)
         pure (ty, kx $> ann)
       ty@(Skolem ann _ mbK _ _) -> do
-        kind <- apply $ mbK
+        kind <- apply mbK
         pure (ty, kind $> ann)
       ty@(TUnknown ann u) -> do
         kind <- apply . snd =<< lookupUnsolved u
@@ -439,7 +371,7 @@ subsumesKind = go
         scope <- maybe newSkolemScope pure mbScope
         skolc <- newSkolemConstant
         go a $ skolemize ann var mbKind skolc scope b
-      (ForAll ann _ var (kind) a _, b) -> do
+      (ForAll ann _ var kind a _, b) -> do
         a' <- freshKindWithKind (fst ann) kind
         go (replaceTypeVars var a' a) b
       (TUnknown ann u, b@(TypeApp _ (TypeApp _ arr _) _))
@@ -495,7 +427,7 @@ unifyKindsWithFailure ::
 unifyKindsWithFailure onFailure = go
   where
     goWithLabel l t1 t2 = withErrorMessageHint (ErrorInRowLabel l) $ go t1 t2
-    go tx1 tx2 = goTrace msg $ case (tx1, tx2) of
+    go tx1 tx2 = case (tx1, tx2) of
       (TypeApp _ p1 p2, TypeApp _ p3 p4) -> do
         go p1 p3
         join $ go <$> apply p2 <*> apply p4
@@ -519,16 +451,7 @@ unifyKindsWithFailure onFailure = go
         solveUnknown a' p1
       (w1, w2) ->
         onFailure w1 w2
-      where
-        msg =
-          "UNIFY KINDS WITH FAILURE"
-            <> "\n  Ty1: "
-            <> prettyTypeStr tx1
-            <> "\n  Ty2: "
-            <> prettyTypeStr tx2
-            <> "\n"
-            <> replicate 20 '-'
-
+ 
     unifyRows r1 r2 = do
       let (matches, rest) = alignRowsWith goWithLabel r1 r2
       sequence_ matches
@@ -613,13 +536,13 @@ elaborateKind = \case
         throwError . errorMessage' (fst ann) . UnknownName . fmap TyName $ v
       Just (kind, _) ->
         ($> ann) <$> apply kind
-  TypeVar ann a kind -> do
+  TypeVar ann _ kind -> do
     -- moduleName <- unsafeCheckCurrentModule
     -- kind <- apply =<< lookupTypeVariable moduleName (Qualified ByNullSourcePos $ ProperName a)
     -- unifyKinds ki kind -- TODO/REVIEW/HACK: I DO NOT KNOW WHETHER THIS IS WHAT WE WANT
     pure (kind $> ann)
   (Skolem ann _ mbK _ _) -> do
-    kind <- apply $ mbK
+    kind <- apply mbK
     pure $ kind $> ann
   TUnknown ann a' -> do
     kind <- snd <$> lookupUnsolved a'
@@ -729,7 +652,7 @@ inferDataDeclaration ::
   ModuleName ->
   DataDeclarationArgs ->
   m [(DataConstructorDeclaration, SourceType)]
-inferDataDeclaration moduleName (ann, tyName, tyArgs, ctors) = do
+inferDataDeclaration moduleName (_, tyName, tyArgs, ctors) = do
   tyKind <- apply =<< lookupTypeVariable moduleName (Qualified ByNullSourcePos tyName)
   let (sigBinders, tyKind') = fromJust . completeBinderList $ tyKind
   bindLocalTypeVariables moduleName (first ProperName . snd <$> sigBinders) $ do
@@ -916,7 +839,7 @@ inferClassDeclaration ::
   ModuleName ->
   ClassDeclarationArgs ->
   m ([(Text, SourceType)], [SourceConstraint], [Declaration])
-inferClassDeclaration moduleName (ann, clsName, clsArgs, superClasses, decls) = do
+inferClassDeclaration moduleName (_, clsName, clsArgs, superClasses, decls) = do
   clsKind <- apply =<< lookupTypeVariable moduleName (Qualified ByNullSourcePos $ coerceProperName clsName)
   let (sigBinders, clsKind') = fromJust . completeBinderList $ clsKind
   bindLocalTypeVariables moduleName (first ProperName . snd <$> sigBinders) $ do
diff --git a/src/Language/PureScript/TypeChecker/Subsumption.hs b/src/Language/PureScript/TypeChecker/Subsumption.hs
index 5187b5e8..f609c9c7 100644
--- a/src/Language/PureScript/TypeChecker/Subsumption.hs
+++ b/src/Language/PureScript/TypeChecker/Subsumption.hs
@@ -19,30 +19,14 @@ import Data.Ord (comparing)
 import Language.PureScript.AST (ErrorMessageHint (..), Expr (..), pattern NullSourceAnn)
 import Language.PureScript.Crash (internalError)
 import Language.PureScript.Environment (tyFunction, tyRecord)
-import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage (..), errorMessage, internalCompilerError)
+import Language.PureScript.Errors (MultipleErrors, SimpleErrorMessage (..), errorMessage)
 import Language.PureScript.TypeChecker.Monad (CheckState, getHints, getTypeClassDictionaries, withErrorMessageHint)
 import Language.PureScript.TypeChecker.Skolems (newSkolemConstant, skolemize)
 import Language.PureScript.TypeChecker.Unify (alignRowsWith, freshTypeWithKind, unifyTypes)
 import Language.PureScript.Types (RowListItem (..), SourceType, Type (..), eqType, isREmpty, replaceTypeVars, rowFromList)
 
-import Debug.Trace (trace, traceM)
 import Language.Purus.Pretty.Types (prettyTypeStr)
 
-moduleTraces :: Bool
-moduleTraces = True
-
-goTrace :: forall x. String -> x -> x
-goTrace str x
-  | moduleTraces = trace str x
-  | otherwise = x
-
-goTraceM :: forall f. (Applicative f) => String -> f ()
-goTraceM msg
-  | moduleTraces = traceM msg
-  | otherwise = pure ()
-
-spacer = "\n" <> replicate 20 '-'
-
 {- | Subsumption can operate in two modes:
 
 * Elaboration mode, in which we try to insert type class dictionaries
@@ -84,16 +68,8 @@ subsumes ::
   SourceType ->
   m (Expr -> Expr)
 subsumes ty1 ty2 =
-  goTrace msg $
     withErrorMessageHint (ErrorInSubsumption ty1 ty2) $
       subsumes' SElaborate ty1 ty2
-  where
-    msg =
-      "SUBSUMES"
-        <> "\n TYPE 1: "
-        <> prettyTypeStr ty1
-        <> "\n TYPE 2: "
-        <> prettyTypeStr ty2
 
 -- | Check that one type subsumes another
 subsumes' ::
diff --git a/src/Language/PureScript/TypeChecker/Types.hs b/src/Language/PureScript/TypeChecker/Types.hs
index 9846090f..bd7066a9 100644
--- a/src/Language/PureScript/TypeChecker/Types.hs
+++ b/src/Language/PureScript/TypeChecker/Types.hs
@@ -77,7 +77,6 @@ import Language.PureScript.TypeChecker.TypeSearch (typeSearch)
 import Language.PureScript.TypeChecker.Unify (freshTypeWithKind, replaceTypeWildcards, substituteType, unifyTypes, unknownsInType, varIfUnknown)
 import Language.PureScript.Types
 
-import Debug.Trace
 import Language.PureScript.Pretty.Values (renderValue)
 import Language.Purus.Pretty.Types (prettyTypeStr)
 
@@ -85,14 +84,10 @@ moduleTraces :: Bool
 moduleTraces = True
 
 goTrace :: forall x. String -> x -> x
-goTrace str x
-  | moduleTraces = trace str x
-  | otherwise = x
+goTrace _ x = x
 
 goTraceM :: forall f. (Applicative f) => String -> f ()
-goTraceM msg
-  | moduleTraces = traceM msg
-  | otherwise = pure ()
+goTraceM _ = pure ()
 
 spacer = '\n' : replicate 20 '-'
 
diff --git a/src/Language/PureScript/TypeChecker/Unify.hs b/src/Language/PureScript/TypeChecker/Unify.hs
index 02bee845..a7af45d6 100644
--- a/src/Language/PureScript/TypeChecker/Unify.hs
+++ b/src/Language/PureScript/TypeChecker/Unify.hs
@@ -35,21 +35,16 @@ import Language.PureScript.TypeChecker.Skolems (newSkolemConstant, skolemize)
 import Language.PureScript.Types (Constraint (..), RowListItem (..), SourceType, Type (..), WildcardData (..), alignRowsWith, everythingOnTypes, everywhereOnTypes, everywhereOnTypesM, getAnnForType, mkForAll, rowFromList, srcTUnknown, pattern REmptyKinded)
 
 import Data.Bifunctor (bimap)
-import Debug.Trace
 import Language.Purus.Pretty.Types (prettyTypeStr)
 
 moduleTraces :: Bool
 moduleTraces = True
 
 goTrace :: forall x. String -> x -> x
-goTrace str x
-  | moduleTraces = trace str x
-  | otherwise = x
+goTrace _ x = x
 
 goTraceM :: forall f. (Applicative f) => String -> f ()
-goTraceM msg
-  | moduleTraces = traceM msg
-  | otherwise = pure ()
+goTraceM _ = pure ()
 
 spacer = "\n" <> replicate 20 '-'