update exportInfo for checked local modules

src/Juvix/Compiler/Concrete/Data/NameSpace.hs

@@ -36,6 +36,15 @@ type family NameSpaceEntryType s = res | res -> s where
   NameSpaceEntryType 'NameSpaceModules = ModuleSymbolEntry
   NameSpaceEntryType 'NameSpaceFixities = FixitySymbolEntry
 
+nsEntry :: forall ns. (SingI ns) => Lens' (NameSpaceEntryType ns) S.Name
+nsEntry = case sing :: SNameSpace ns of
+  SNameSpaceModules -> moduleEntry
+  SNameSpaceSymbols -> preSymbolName
+  SNameSpaceFixities -> fixityEntry
+
+shouldExport :: (SingI ns) => NameSpaceEntryType ns -> Bool
+shouldExport ent = ent ^. nsEntry . S.nameVisibilityAnn == VisPublic
+
 forEachNameSpace :: (Monad m) => (forall (ns :: NameSpace). Sing ns -> m ()) -> m ()
 forEachNameSpace f = sequence_ [withSomeSing ns f | ns <- allElements]
 

src/Juvix/Compiler/Concrete/Data/Scope.hs

@@ -11,15 +11,8 @@ import Juvix.Compiler.Concrete.Data.Scope.Base
 import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
 import Juvix.Compiler.Concrete.Language
 import Juvix.Compiler.Store.Scoped.Data.InfoTable
-import Juvix.Compiler.Store.Scoped.Language
 import Juvix.Prelude
 
-nsEntry :: forall ns. (SingI ns) => Lens' (NameSpaceEntryType ns) S.Name
-nsEntry = case sing :: SNameSpace ns of
-  SNameSpaceModules -> moduleEntry
-  SNameSpaceSymbols -> preSymbolName
-  SNameSpaceFixities -> fixityEntry
-
 scopeReservedNameSpace :: forall (ns :: NameSpace). Sing ns -> Lens' Scope (HashMap Symbol S.Symbol)
 scopeReservedNameSpace s = case s of
   SNameSpaceSymbols -> scopeReservedSymbols

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

@@ -1057,9 +1057,6 @@ exportScope scope@Scope {..} = do
         [e] -> return (Just (s, e))
         e : es -> err (e :| es)
       where
-        shouldExport :: NameSpaceEntryType ns -> Bool
-        shouldExport ent = ent ^. nsEntry . S.nameVisibilityAnn == VisPublic
-
         err :: NonEmpty (NameSpaceEntryType ns) -> Sem r a
         err es =
           throw
@@ -1651,7 +1648,7 @@ checkInductiveDef InductiveDef {..} = do
             checkRecordStatement :: Reserved -> RecordStatement 'Parsed -> Sem r (RecordStatement 'Scoped)
             checkRecordStatement scopeSyntax = \case
               RecordStatementField d -> RecordStatementField <$> checkField d
-              RecordStatementSyntax s -> RecordStatementSyntax <$> withLocalReservedScope scopeSyntax (checkRecordSyntaxDef s)
+              RecordStatementSyntax s -> RecordStatementSyntax <$> (withLocalScope (putReservedInScope scopeSyntax >> (checkRecordSyntaxDef s)))
 
             checkField :: RecordField 'Parsed -> Sem r (RecordField 'Scoped)
             checkField RecordField {..} = do
@@ -1803,17 +1800,6 @@ withTopScope ma = do
   put scope'
   ma
 
-withLocalReservedScope ::
-  forall r a.
-  (Members '[Reader BindingStrategy, State Scope] r) =>
-  Reserved ->
-  Sem r a ->
-  Sem r a
-withLocalReservedScope reserved localScoped = withLocalScope $ do
-  modify (set scopeReserved reserved)
-  putReservedInScope reserved
-  localScoped
-
 withLocalScope :: (Members '[State Scope] r) => Sem r a -> Sem r a
 withLocalScope ma = do
   before <- get @Scope
@@ -2192,26 +2178,25 @@ checkLocalModule md@Module {..} = do
   reservedModule <- getReservedLocalModule ["lo"] modEntry
   let reserved = reservedModule ^. reservedModuleReserved
   (tab, (exportInfo, moduleBody', moduleDoc')) <-
-    withLocalReservedScope reserved
+    withLocalScope
       . runReader (tab1 <> tab2)
       . runInfoTableBuilder mempty
       $ 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)
-        inheritScope _modulePath
         e1 <- get >>= exportScope
         traceM ("AFTER inherit check local module " <> ppTrace _modulePath' <> " with\n" <> ppTrace e1)
-        -- TODO we call putReservedInScope twice, also in withLocalReservedScope
-        putReservedInScope reserved
-        e2 <- get >>= exportScope
-        traceM ("AFTER PUT Reserved check local module " <> ppTrace _modulePath' <> " with\n" <> ppTrace e2)
         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)
   let moduleName = S.unqualifiedSymbol _modulePath'
       m =
         Module
@@ -2252,10 +2237,7 @@ putReservedInScope ::
 putReservedInScope reserved = forEachNameSpace $ \ns ->
   forM_ (HashMap.toList (reserved ^. reservedNameSpace ns)) $ \(s, s') -> do
     let kind = getNameKind s'
-    traceM ("putreserved " <> ppTrace s)
     addToScope ns kind s s'
-    e <- fromRight' <$> runError @ScoperError (get >>= exportScope)
-    traceM ("after  " <> ppTrace e)
 
 -- TODO remove
 -- checkOrphanOperators :: forall r. (Members '[Error ScoperError, State ScoperSyntax] r) => Sem r ()
@@ -2409,6 +2391,7 @@ 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)