[scoper] Add visibility annotation for Name

src/MiniJuvix/Syntax/Concrete/Language.hs

@@ -3,6 +3,7 @@ module MiniJuvix.Syntax.Concrete.Language
   ( module MiniJuvix.Syntax.Concrete.Language,
     module MiniJuvix.Syntax.Concrete.Name,
     module MiniJuvix.Syntax.Concrete.Loc,
+    module MiniJuvix.Syntax.Concrete.Scoped.VisibilityAnn,
     module MiniJuvix.Syntax.Concrete.PublicAnn,
     module MiniJuvix.Syntax.Concrete.ModuleIsTop,
     module MiniJuvix.Syntax.Concrete.Language.Stage,
@@ -20,6 +21,7 @@ import MiniJuvix.Syntax.Concrete.Language.Stage
 import MiniJuvix.Syntax.Concrete.Loc
 import MiniJuvix.Syntax.Concrete.ModuleIsTop
 import MiniJuvix.Syntax.Concrete.Name
+import MiniJuvix.Syntax.Concrete.Scoped.VisibilityAnn
 import MiniJuvix.Syntax.Concrete.PublicAnn
 import MiniJuvix.Syntax.Concrete.Scoped.Name (unqualifiedSymbol)
 import qualified MiniJuvix.Syntax.Concrete.Scoped.Name as S

src/MiniJuvix/Syntax/Concrete/Scoped/Name.hs

@@ -11,7 +11,7 @@ import Lens.Micro.Platform
 import MiniJuvix.Prelude
 import MiniJuvix.Syntax.Concrete.Loc
 import qualified MiniJuvix.Syntax.Concrete.Name as C
-import MiniJuvix.Syntax.Concrete.PublicAnn
+import MiniJuvix.Syntax.Concrete.Scoped.VisibilityAnn
 import MiniJuvix.Syntax.Concrete.Scoped.Name.NameKind
 import qualified MiniJuvix.Syntax.Fixity as C
 import Prettyprinter
@@ -90,7 +90,7 @@ data Name' n = Name'
     _nameDefinedIn :: AbsModulePath,
     _nameFixity :: Maybe C.Fixity,
     _nameWhyInScope :: WhyInScope,
-    _namePublicAnn :: PublicAnn,
+    _nameVisibilityAnn :: VisibilityAnn,
     -- | The textual representation of the name at the binding site
     _nameVerbatim :: Text
   }

src/MiniJuvix/Syntax/Concrete/Scoped/Scoper.hs

@@ -83,7 +83,7 @@ freshSymbol _nameKind _nameConcrete = do
   _nameDefinedIn <- gets _scopePath
   let _nameDefined = getLoc _nameConcrete
       _nameWhyInScope = S.BecauseDefined
-      _namePublicAnn = NoPublic
+      _nameVisibilityAnn = VisPublic
       _nameVerbatim = _symbolText _nameConcrete
   _nameFixity <- fixity
   return S.Name' {..}
@@ -347,9 +347,7 @@ exportScope Scope {..} = do
     getExportSymbols = HashMap.fromList <$> mapMaybeM entry (HashMap.toList _scopeSymbols)
       where
         shouldExport :: SymbolEntry -> Bool
-        shouldExport ent =
-          _nameDefinedIn == _scopePath
-            || _namePublicAnn == Public
+        shouldExport ent = _nameVisibilityAnn == VisPublic
           where
             S.Name' {..} = entryName ent
 
@@ -511,7 +509,8 @@ checkTopModule m@(Module path params body) = do
           _nameDefined = getLoc (_modulePathName path)
           _nameKind = S.KNameTopModule
           _nameFixity = Nothing
-          _namePublicAnn = NoPublic
+          -- This visibility annotation is not relevant
+          _nameVisibilityAnn = VisPublic
           _nameWhyInScope = S.BecauseDefined
           _nameVerbatim = N.topModulePathToDottedPath path
       return S.Name' {..}
@@ -589,7 +588,7 @@ checkLocalModule Module {..} = do
         inheritSymbol :: SymbolInfo -> SymbolInfo
         inheritSymbol (SymbolInfo s) = SymbolInfo (fmap inheritEntry s)
         inheritEntry :: SymbolEntry -> SymbolEntry
-        inheritEntry = entryOverName (over S.nameWhyInScope S.BecauseInherited)
+        inheritEntry = entryOverName (over S.nameWhyInScope S.BecauseInherited . set S.nameVisibilityAnn VisPrivate)
 
 checkClausesExist :: forall r. Members '[Error ScopeError, State Scope] r => [Statement 'Scoped] -> Sem r ()
 checkClausesExist ss = whenJust msig (throw . ErrLacksFunctionClause . LacksFunctionClause)
@@ -680,9 +679,14 @@ checkOpenModule OpenModule {..} = do
     alterScope = alterEntries . filterScope
       where
         alterEntry :: SymbolEntry -> SymbolEntry
-        alterEntry = entryOverName (set S.nameWhyInScope S.BecauseImportedOpened . set S.namePublicAnn _openPublic)
+        alterEntry = entryOverName (set S.nameWhyInScope S.BecauseImportedOpened
+                                    . set S.nameVisibilityAnn (publicAnnToVis _openPublic))
         alterEntries :: ExportInfo -> ExportInfo
         alterEntries = over exportSymbols (fmap alterEntry)
+        publicAnnToVis :: PublicAnn -> VisibilityAnn
+        publicAnnToVis = \case
+          Public -> VisPublic
+          NoPublic -> VisPrivate
         filterScope :: ExportInfo -> ExportInfo
         filterScope = over exportSymbols filterTable
           where

src/MiniJuvix/Syntax/Concrete/Scoped/VisibilityAnn.hs

@@ -0,0 +1,8 @@
+module MiniJuvix.Syntax.Concrete.Scoped.VisibilityAnn where
+
+import MiniJuvix.Prelude
+
+data VisibilityAnn
+  = VisPublic
+  | VisPrivate
+  deriving stock (Show, Eq, Ord)