remove debug messages

src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs

@@ -1,6 +1,3 @@
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
-{-# HLINT ignore "Use list literal" #-}
 module Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping
   ( module Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Data.Context,
     module Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error,
@@ -19,7 +16,6 @@ import Control.Monad.Combinators.Expr qualified as P
 import Data.HashMap.Strict qualified as HashMap
 import Data.HashSet qualified as HashSet
 import Data.List.NonEmpty qualified as NonEmpty
-import Data.Text qualified as Text
 import GHC.Base (maxInt, minInt)
 import Juvix.Compiler.Concrete.Data.Highlight.Builder
 import Juvix.Compiler.Concrete.Data.InfoTableBuilder
@@ -332,7 +328,6 @@ addToScope ns kind s s' = withSingI ns $ do
         Just SymbolInfo {..} -> case strat of
           BindingLocal -> symbolInfoSingle mentry
           BindingTop -> SymbolInfo (HashMap.insert path mentry _symbolInfo)
-  traceM ("add to scope:" <> ppTrace u <> " vis " <> ppTrace (u ^. S.nameVisibilityAnn))
   modify (over scopeNameSpaceI (HashMap.alter (Just . addS entry) s))
   where
     isAlias = case kind of
@@ -788,8 +783,6 @@ checkImportNoPublic import_@Import {..} = do
 
     registerScoperModules :: ScopedModule -> Sem r ()
     registerScoperModules m = do
-      traceM ("register scoper modules " <> ppTrace m <> " with ExportInfo = \n" <> ppTrace (m ^. scopedModuleExportInfo))
-
       modify (set (scoperModules . at (m ^. scopedModulePath . S.nameId)) (Just m))
       modify (set (scoperReservedModules . at (m ^. scopedModulePath . S.nameId)) (Just (scopedToReservedModule m)))
       forM_ (m ^. scopedModuleLocalModules) registerScoperModules
@@ -801,23 +794,17 @@ getTopModulePath Module {..} =
       S._absLocalPath = mempty
     }
 
-getModuleExportInfo :: forall r. (HasCallStack, Members '[State ScoperState] r) => [Text] -> ModuleSymbolEntry -> Sem r ExportInfo
-getModuleExportInfo msg = fmap (^. reservedModuleExportInfo) . getReservedLocalModule ("getModuleExportInfo" : msg)
+getModuleExportInfo :: forall r. (HasCallStack, Members '[State ScoperState] r) => ModuleSymbolEntry -> Sem r ExportInfo
+getModuleExportInfo = fmap (^. reservedModuleExportInfo) . getReservedLocalModule
 
-getReservedLocalModule :: forall r. (HasCallStack, Members '[State ScoperState] r) => [Text] -> ModuleSymbolEntry -> Sem r ReservedModule
-getReservedLocalModule debug m = fromMaybeM err (gets (^. scoperReservedModules . at (m ^. moduleEntry . S.nameId)))
+getReservedLocalModule :: forall r. (HasCallStack, Members '[State ScoperState] r) => ModuleSymbolEntry -> Sem r ReservedModule
+getReservedLocalModule m = fromMaybeM err (gets (^. scoperReservedModules . at (m ^. moduleEntry . S.nameId)))
   where
     err :: Sem r a
     err = do
       ms <- toList <$> gets (^. scoperReservedModules)
       impossibleError
-        ( "getReservedLocalModule\n"
-            <> Text.unlines debug
-            <> "\ncallStack =\n"
-            <> ghcCallStack
-            <> "\n"
-            <> ". "
-            <> "Could not find "
+        ( "Could not find "
             <> ppTrace m
             <> "\nModules in the state: "
             <> ppTrace ms
@@ -826,19 +813,18 @@ getReservedLocalModule debug m = fromMaybeM err (gets (^. scoperReservedModules
 lookupLocalSymbolAux ::
   forall r.
   (HasCallStack, Members '[State ScoperState, State Scope, Output ModuleSymbolEntry, Output PreSymbolEntry, Output FixitySymbolEntry] r) =>
-  [Text] ->
   (S.WhyInScope -> Bool) ->
   [Symbol] ->
   Symbol ->
   Sem r ()
-lookupLocalSymbolAux msg whyInScope modules final =
+lookupLocalSymbolAux whyInScope modules final =
   case modules of
     [] ->
       lookHere
     p : ps -> do
       entries <- gets (^.. scopeModuleSymbols . at p . _Just . symbolInfo . each)
       let entries' = filter (whyInScope . (^. moduleEntry . S.nameWhyInScope)) entries
-      mapM_ (getModuleExportInfo ("lookupLocalSymbolAux" : msg) >=> lookInExport final ps) entries'
+      mapM_ (getModuleExportInfo >=> lookInExport final ps) entries'
   where
     lookHere :: Sem r ()
     lookHere = do
@@ -859,11 +845,10 @@ lookupLocalSymbolAux msg whyInScope modules final =
 lookupSymbolAux ::
   forall r.
   (HasCallStack, Members '[State ScoperState, State Scope, Output ModuleSymbolEntry, Output PreSymbolEntry, Output FixitySymbolEntry] r) =>
-  [Text] ->
   [Symbol] ->
   Symbol ->
   Sem r ()
-lookupSymbolAux debug modules final = do
+lookupSymbolAux modules final = do
   hereOrInLocalModule
   importedTopModule
   where
@@ -880,15 +865,14 @@ lookupSymbolAux debug modules final = do
         lookPrefix pref' path2 modules'
       when (notNull pref) $
         lookPrefix pref path2 modules
-      lookupLocalSymbolAux ("lookupSymbolAux" : debug) (const True) modules final
+      lookupLocalSymbolAux (const True) modules final
 
     lookPrefix :: [Symbol] -> [Symbol] -> [Symbol] -> Sem r ()
     lookPrefix pref path modules' = do
       let prefLen = length pref
           inheritDepth = length path - prefLen
           modules'' = drop prefLen modules'
       lookupLocalSymbolAux
-        ("lookPrefix" : [])
         (== iterate S.BecauseInherited S.BecauseDefined !! inheritDepth)
         modules''
         final
@@ -919,17 +903,16 @@ lookInExport sym remaining e = case remaining of
   where
     mayModule :: ExportInfo -> Symbol -> Sem r (Maybe ExportInfo)
     mayModule ExportInfo {..} s =
-      mapM (getModuleExportInfo ("lookInExport" : [])) (HashMap.lookup s _exportModuleSymbols)
+      mapM getModuleExportInfo (HashMap.lookup s _exportModuleSymbols)
 
 -- | We return a list of entries because qualified names can point to different
 -- modules due to nesting.
 lookupQualifiedSymbol ::
   forall r.
   (Members '[State Scope, State ScoperState] r) =>
-  [Text] ->
   ([Symbol], Symbol) ->
   Sem r (HashSet PreSymbolEntry, HashSet ModuleSymbolEntry, HashSet FixitySymbolEntry)
-lookupQualifiedSymbol debug sms = do
+lookupQualifiedSymbol sms = do
   (es, (ms, fs)) <-
     runOutputHashSet
       . runOutputHashSet
@@ -948,7 +931,7 @@ lookupQualifiedSymbol debug sms = do
       where
         -- Current module.
         here :: Sem r' ()
-        here = lookupSymbolAux ("here" : debug) path sym
+        here = lookupSymbolAux path sym
         -- Looks for top level modules
         there :: Sem r' ()
         there = mapM_ (uncurry lookInTopModule) allTopPaths
@@ -989,7 +972,7 @@ checkQualifiedName ::
   QualifiedName ->
   Sem r PreSymbolEntry
 checkQualifiedName q@(QualifiedName (SymbolPath p) sym) = do
-  es <- fst3 <$> lookupQualifiedSymbol ["checkQualifiedName"] (toList p, sym)
+  es <- fst3 <$> lookupQualifiedSymbol (toList p, sym)
   case toList es of
     [] -> notInScope
     [e] -> return e
@@ -1766,7 +1749,6 @@ checkTopModule m@Module {..} = checkedModule
                 registerModuleDoc (path' ^. S.nameId) doc'
                 return (e, body', path', doc')
       localModules <- getScopedLocalModules e
-      traceM ("local modules = " <> ppTrace localModules)
       _moduleId <- getModuleId (topModulePathKey (path' ^. S.nameConcrete))
       doctbl <- getDocTable _moduleId
       let md =
@@ -1830,7 +1812,7 @@ checkLocalModuleBody ::
   ModuleSymbolEntry ->
   Sem r [Statement 'Scoped]
 checkLocalModuleBody m = do
-  res <- getReservedLocalModule ("checkLocalModuleBody" : []) m
+  res <- getReservedLocalModule m
   let body = res ^. reservedModuleStatements
   syntaxBlockTop (checkReservedStatements body)
 
@@ -2121,7 +2103,6 @@ reserveLocalModule Module {..} = do
     inheritScope _modulePath
     b <- reserveStatements _moduleBody
     export <- get >>= exportScope
-    traceM ("Reserved export for " <> ppTrace _modulePath' <> "\n" <> ppTrace export)
     reserved <- gets (^. scopeReserved)
     return
       ReservedModule
@@ -2175,7 +2156,7 @@ checkLocalModule md@Module {..} = do
   _modulePath' :: S.Symbol <- getReservedLocalModuleSymbol _modulePath
   let modEntry = ModuleSymbolEntry (S.unqualifiedSymbol _modulePath')
       mid = _modulePath' ^. S.nameId
-  reservedModule <- getReservedLocalModule ["lo"] modEntry
+  reservedModule <- getReservedLocalModule modEntry
   let reserved = reservedModule ^. reservedModuleReserved
   (tab, (exportInfo, moduleBody', moduleDoc')) <-
     withLocalScope
@@ -2185,15 +2166,10 @@ checkLocalModule md@Module {..} = do
         inheritScope _modulePath
         modify (set scopeReserved reserved)
         putReservedInScope reserved
-        e0 <- get >>= exportScope
-        traceM ("BEFORE check local module " <> ppTrace _modulePath' <> " with\n" <> ppTrace e0)
         modify (set scopeModuleId mid)
-        e1 <- get >>= exportScope
-        traceM ("AFTER inherit check local module " <> ppTrace _modulePath' <> " with\n" <> ppTrace e1)
         b <- checkLocalModuleBody modEntry
         doc' <- mapM checkJudoc _moduleDoc
         e <- get >>= exportScope
-        traceM ("AFTER check local module " <> ppTrace _modulePath' <> " with\n" <> ppTrace e)
         return (e, b, doc')
   localModules <- getScopedLocalModules exportInfo
   modify (set (scoperReservedModules . at mid . _Just . reservedModuleExportInfo) exportInfo)
@@ -2276,7 +2252,7 @@ lookupModuleSymbol ::
   Name ->
   Sem r ReservedModule
 lookupModuleSymbol n = do
-  es <- snd3 <$> lookupQualifiedSymbol ["lookupModuleSymbol"] (path, sym)
+  es <- snd3 <$> lookupQualifiedSymbol (path, sym)
   case nonEmpty (resolveShadowing (toList es)) of
     Nothing -> notInScope
     Just (x :| []) -> getModule x n
@@ -2391,7 +2367,6 @@ checkOpenModuleHelper ::
   Sem r (OpenModule 'Scoped short)
 checkOpenModuleHelper reservedMod OpenModule {..} = do
   let exportInfo = reservedMod ^. reservedModuleExportInfo
-  traceM ("open module " <> ppTrace (reservedMod ^. reservedModuleName) <> "\n" <> ppTrace exportInfo)
   registerName False (reservedMod ^. reservedModuleName)
   usingHiding' <- mapM (checkUsingHiding (reservedMod ^. reservedModuleName) exportInfo) _openModuleUsingHiding
   mergeScope (filterExportInfo _openModulePublic usingHiding' exportInfo)
@@ -2895,7 +2870,7 @@ checkUnqualifiedName ::
 checkUnqualifiedName s = do
   scope <- get
   -- Lookup at the global scope
-  entries <- fst3 <$> lookupQualifiedSymbol ["checkUnqualifiedName"] ([], s)
+  entries <- fst3 <$> lookupQualifiedSymbol ([], s)
   case resolveShadowing (toList entries) of
     [] -> throw (ErrSymNotInScope (NotInScope s scope))
     [x] -> return x
@@ -2910,7 +2885,7 @@ checkFixitySymbol ::
 checkFixitySymbol s = do
   scope <- get
   -- Lookup at the global scope
-  entries <- thd3 <$> lookupQualifiedSymbol ["checkFixitySymbol"] ([], s)
+  entries <- thd3 <$> lookupQualifiedSymbol ([], s)
   case resolveShadowing (toList entries) of
     [] -> throw (ErrSymNotInScope (NotInScope s scope))
     [x] -> do
@@ -3009,7 +2984,7 @@ lookupNameOfKind ::
   Name ->
   Sem r (Maybe ScopedIden)
 lookupNameOfKind nameKind n = do
-  entries <- lookupQualifiedSymbol ["lookupNameOfKind"] (path, sym) >>= mapMaybeM filterEntry . toList . fst3
+  entries <- lookupQualifiedSymbol (path, sym) >>= mapMaybeM filterEntry . toList . fst3
   case entries of
     [] -> return Nothing
     [(_, s)] -> return (Just s) -- There is one constructor with such a name

src/Juvix/Compiler/Internal/Builtins.hs

@@ -51,34 +51,33 @@ checkBuiltinFunctionInfo ::
   (Members '[Error ScoperError] r) =>
   FunInfo ->
   Sem r ()
-checkBuiltinFunctionInfo fi = return ()
-
--- let op = fi ^. funInfoDef . funDefName
---     ty = fi ^. funInfoDef . funDefType
---     sig = fi ^. funInfoSignature
---     err :: forall a. AnsiText -> Sem r a
---     err = builtinsErrorMsg (getLoc (fi ^. funInfoDef))
--- unless ((sig ==% ty) (hashSet (fi ^. funInfoFreeTypeVars))) (err "builtin has the wrong type signature")
--- let freeVars = hashSet (fi ^. funInfoFreeVars)
---     a =% b = (a ==% b) freeVars
---     clauses :: [(Expression, Expression)]
---     clauses =
---       [ (clauseLhsAsExpression op (toList pats), body)
---         | Just cls <- [unfoldLambdaClauses (fi ^. funInfoDef . funDefBody)],
---           (pats, body) <- toList cls
---       ]
--- case zipExactMay (fi ^. funInfoClauses) clauses of
---   Nothing -> err "builtin has the wrong number of clauses"
---   Just z -> forM_ z $ \((exLhs, exBody), (lhs, body)) -> do
---     unless
---       (exLhs =% lhs)
---       ( err
---           ( "clause lhs does not match for "
---               <> ppOutDefault op
---               <> "\nExpected: "
---               <> ppOutDefault exLhs
---               <> "\nActual: "
---               <> ppOutDefault lhs
---           )
---       )
---     unless (exBody =% body) (error $ "clause body does not match " <> ppTrace exBody <> " | " <> ppTrace body)
+checkBuiltinFunctionInfo fi = do
+  let op = fi ^. funInfoDef . funDefName
+      ty = fi ^. funInfoDef . funDefType
+      sig = fi ^. funInfoSignature
+      err :: forall a. AnsiText -> Sem r a
+      err = builtinsErrorMsg (getLoc (fi ^. funInfoDef))
+  unless ((sig ==% ty) (hashSet (fi ^. funInfoFreeTypeVars))) (err "builtin has the wrong type signature")
+  let freeVars = hashSet (fi ^. funInfoFreeVars)
+      a =% b = (a ==% b) freeVars
+      clauses :: [(Expression, Expression)]
+      clauses =
+        [ (clauseLhsAsExpression op (toList pats), body)
+          | Just cls <- [unfoldLambdaClauses (fi ^. funInfoDef . funDefBody)],
+            (pats, body) <- toList cls
+        ]
+  case zipExactMay (fi ^. funInfoClauses) clauses of
+    Nothing -> err "builtin has the wrong number of clauses"
+    Just z -> forM_ z $ \((exLhs, exBody), (lhs, body)) -> do
+      unless
+        (exLhs =% lhs)
+        ( err
+            ( "clause lhs does not match for "
+                <> ppOutDefault op
+                <> "\nExpected: "
+                <> ppOutDefault exLhs
+                <> "\nActual: "
+                <> ppOutDefault lhs
+            )
+        )
+      unless (exBody =% body) (error $ "clause body does not match " <> ppTrace exBody <> " | " <> ppTrace body)

src/Juvix/Prelude/Trace.hs

@@ -31,8 +31,7 @@ trace = traceLabel ""
 
 traceM :: (Applicative f) => Text -> f ()
 traceM t = traceLabel "" t (pure ())
-
--- {-# WARNING traceM "Using traceM" #-}
+{-# WARNING traceM "Using traceM" #-}
 
 traceShow :: (Show b) => b -> b
 traceShow b = traceLabel "" (pack . show $ b) b