Store syntax aliases in serialized scoper infotable (#2605)

This PR fixes an issue with importing `syntax alias` and using them from
another module:

Say you have a module defining a syntax alias:

```
module SyntaxAlias;

import Stdlib.Prelude open;

syntax alias MyNat := Nat;
```

and another which imports / uses it:

```
module test073;

import SyntaxAlias open;

main : MyNat := 11;
```

The compiler crashed with the following error:

```
^?!): empty Fold
            CallStack (from HasCallStack):
              error, called at src/Lens/Micro.hs:711:28 in microlens-0.4.13.1-ARwI8t2x86cAxRs56XPcG1:Lens.Micro
              ^?!, called at src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs:565:29 in juvix-0.5.5-G7jC6MbkbsJGkMT9u4BkYQ:Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping
```

We fix this by adding the aliases to the store's [scoper info
table](6649209d26/src/Juvix/Compiler/Store/Scoped/Data/InfoTable.hs (L14))
and then use it to initialise the scoper state when scoping a module.

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

@@ -7,6 +7,7 @@ import Juvix.Compiler.Concrete.Data.Scope
 import Juvix.Compiler.Concrete.Data.ScopedName
 import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
 import Juvix.Compiler.Concrete.Language
+import Juvix.Compiler.Store.Scoped.Language
 import Juvix.Prelude
 
 data InfoTableBuilder m a where
@@ -25,6 +26,7 @@ data InfoTableBuilder m a where
   RegisterParsedNameSig :: S.NameId -> NameSignature 'Parsed -> InfoTableBuilder m ()
   RegisterParsedConstructorSig :: S.NameId -> RecordNameSignature 'Parsed -> InfoTableBuilder m ()
   RegisterRecordInfo :: S.NameId -> RecordInfo -> InfoTableBuilder m ()
+  RegisterAlias :: S.NameId -> PreSymbolEntry -> InfoTableBuilder m ()
   GetInfoTable :: InfoTableBuilder m InfoTable
 
 makeSem ''InfoTableBuilder
@@ -84,6 +86,8 @@ toState = reinterpret $ \case
     modify (over infoParsedConstructorSigs (HashMap.insert uid sig))
   RegisterRecordInfo uid recInfo ->
     modify (over infoRecords (HashMap.insert uid recInfo))
+  RegisterAlias uid a ->
+    modify (over infoScoperAlias (HashMap.insert uid a))
   GetInfoTable ->
     get
 

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

@@ -51,7 +51,7 @@ iniScoperState tab =
       _scoperSignatures = tab ^. infoParsedNameSigs,
       _scoperScopedSignatures = tab ^. infoNameSigs,
       _scoperRecordFields = tab ^. infoRecords,
-      _scoperAlias = mempty,
+      _scoperAlias = tab ^. infoScoperAlias,
       _scoperConstructorFields = tab ^. infoParsedConstructorSigs,
       _scoperScopedConstructorFields = tab ^. infoConstructorSigs
     }
@@ -1244,6 +1244,7 @@ checkSections sec = do
               asName <- checkName (a ^. aliasDefAsName)
               modify' (set (scoperAlias . at aliasId) (Just asName))
               checkLoop aliasId
+              registerAlias aliasId asName
               where
                 checkLoop :: NameId -> Sem r' ()
                 checkLoop = evalState (mempty :: HashSet NameId) . go

src/Juvix/Compiler/Store/Scoped/Data/InfoTable.hs

@@ -4,6 +4,7 @@ import Data.HashMap.Strict qualified as HashMap
 import Data.HashSet qualified as HashSet
 import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
 import Juvix.Compiler.Concrete.Language
+import Juvix.Compiler.Store.Scoped.Data.SymbolEntry
 import Juvix.Extra.Serialize
 import Juvix.Prelude
 
@@ -24,7 +25,8 @@ data InfoTable = InfoTable
     _infoFunctions :: HashMap NameId (FunctionDef 'Scoped),
     _infoInductives :: HashMap NameId (InductiveDef 'Scoped),
     _infoConstructors :: HashMap NameId (ConstructorDef 'Scoped),
-    _infoAxioms :: HashMap NameId (AxiomDef 'Scoped)
+    _infoAxioms :: HashMap NameId (AxiomDef 'Scoped),
+    _infoScoperAlias :: HashMap S.NameId PreSymbolEntry
   }
   deriving stock (Generic)
 
@@ -47,7 +49,8 @@ instance Semigroup InfoTable where
         _infoFunctions = tab1 ^. infoFunctions <> tab2 ^. infoFunctions,
         _infoInductives = tab1 ^. infoInductives <> tab2 ^. infoInductives,
         _infoConstructors = tab1 ^. infoConstructors <> tab2 ^. infoConstructors,
-        _infoAxioms = tab1 ^. infoAxioms <> tab2 ^. infoAxioms
+        _infoAxioms = tab1 ^. infoAxioms <> tab2 ^. infoAxioms,
+        _infoScoperAlias = tab1 ^. infoScoperAlias <> tab2 ^. infoScoperAlias
       }
 
 instance Monoid InfoTable where
@@ -65,7 +68,8 @@ instance Monoid InfoTable where
         _infoFunctions = mempty,
         _infoInductives = mempty,
         _infoConstructors = mempty,
-        _infoAxioms = mempty
+        _infoAxioms = mempty,
+        _infoScoperAlias = mempty
       }
 
 combinePrecedenceGraphs :: PrecedenceGraph -> PrecedenceGraph -> PrecedenceGraph

src/Juvix/Compiler/Store/Scoped/Data/SymbolEntry.hs

@@ -0,0 +1,78 @@
+module Juvix.Compiler.Store.Scoped.Data.SymbolEntry where
+
+import Juvix.Compiler.Concrete.Data.ScopedName (HasNameKind)
+import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
+import Juvix.Extra.Serialize
+import Juvix.Prelude
+
+newtype Alias = Alias
+  { _aliasName :: S.Name
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+
+instance Serialize Alias
+
+-- | Either an alias or a symbol entry.
+data PreSymbolEntry
+  = PreSymbolAlias Alias
+  | PreSymbolFinal SymbolEntry
+  deriving stock (Show, Eq, Ord, Generic)
+
+instance Serialize PreSymbolEntry
+
+-- | A symbol which is not an alias.
+newtype SymbolEntry = SymbolEntry
+  { _symbolEntry :: S.Name
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+
+instance Hashable SymbolEntry
+
+instance Serialize SymbolEntry
+
+newtype ModuleSymbolEntry = ModuleSymbolEntry
+  { _moduleEntry :: S.Name
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+
+instance Serialize ModuleSymbolEntry
+
+newtype FixitySymbolEntry = FixitySymbolEntry
+  { _fixityEntry :: S.Name
+  }
+  deriving stock (Show, Eq, Ord, Generic)
+
+instance Serialize FixitySymbolEntry
+
+makeLenses ''Alias
+makeLenses ''SymbolEntry
+makeLenses ''ModuleSymbolEntry
+makeLenses ''FixitySymbolEntry
+
+instance HasLoc Alias where
+  getLoc = (^. aliasName . S.nameDefined)
+
+instance HasLoc PreSymbolEntry where
+  getLoc = \case
+    PreSymbolAlias a -> getLoc a
+    PreSymbolFinal a -> getLoc a
+
+instance HasLoc SymbolEntry where
+  getLoc = (^. symbolEntry . S.nameDefined)
+
+instance HasNameKind ModuleSymbolEntry where
+  getNameKind (ModuleSymbolEntry s) = S.getNameKind s
+
+instance HasLoc ModuleSymbolEntry where
+  getLoc (ModuleSymbolEntry s) = s ^. S.nameDefined
+
+symbolEntryNameId :: SymbolEntry -> NameId
+symbolEntryNameId = (^. symbolEntry . S.nameId)
+
+instance HasNameKind SymbolEntry where
+  getNameKind = S.getNameKind . (^. symbolEntry)
+
+preSymbolName :: Lens' PreSymbolEntry S.Name
+preSymbolName f = \case
+  PreSymbolAlias a -> PreSymbolAlias <$> traverseOf aliasName f a
+  PreSymbolFinal a -> PreSymbolFinal <$> traverseOf symbolEntry f a

src/Juvix/Compiler/Store/Scoped/Language.hs

@@ -1,52 +1,17 @@
-module Juvix.Compiler.Store.Scoped.Language where
+module Juvix.Compiler.Store.Scoped.Language
+  ( module Juvix.Compiler.Store.Scoped.Data.SymbolEntry,
+    module Juvix.Compiler.Store.Scoped.Language,
+  )
+where
 
 import Data.HashSet qualified as HashSet
 import Juvix.Compiler.Concrete.Data.Name qualified as C
-import Juvix.Compiler.Concrete.Data.ScopedName (HasNameKind)
 import Juvix.Compiler.Concrete.Data.ScopedName qualified as S
 import Juvix.Compiler.Store.Scoped.Data.InfoTable
+import Juvix.Compiler.Store.Scoped.Data.SymbolEntry
 import Juvix.Extra.Serialize
 import Juvix.Prelude
 
-newtype Alias = Alias
-  { _aliasName :: S.Name
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-
-instance Serialize Alias
-
--- | Either an alias or a symbol entry.
-data PreSymbolEntry
-  = PreSymbolAlias Alias
-  | PreSymbolFinal SymbolEntry
-  deriving stock (Show, Eq, Ord, Generic)
-
-instance Serialize PreSymbolEntry
-
--- | A symbol which is not an alias.
-newtype SymbolEntry = SymbolEntry
-  { _symbolEntry :: S.Name
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-
-instance Hashable SymbolEntry
-
-instance Serialize SymbolEntry
-
-newtype ModuleSymbolEntry = ModuleSymbolEntry
-  { _moduleEntry :: S.Name
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-
-instance Serialize ModuleSymbolEntry
-
-newtype FixitySymbolEntry = FixitySymbolEntry
-  { _fixityEntry :: S.Name
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-
-instance Serialize FixitySymbolEntry
-
 -- | Symbols that a module exports
 data ExportInfo = ExportInfo
   { _exportSymbols :: HashMap C.Symbol PreSymbolEntry,
@@ -74,42 +39,10 @@ newtype ScopedModuleTable = ScopedModuleTable
   { _scopedModuleTable :: HashMap C.TopModulePath ScopedModule
   }
 
-makeLenses ''Alias
-makeLenses ''SymbolEntry
-makeLenses ''ModuleSymbolEntry
-makeLenses ''FixitySymbolEntry
 makeLenses ''ExportInfo
 makeLenses ''ScopedModule
 makeLenses ''ScopedModuleTable
 
-instance HasLoc Alias where
-  getLoc = (^. aliasName . S.nameDefined)
-
-instance HasLoc PreSymbolEntry where
-  getLoc = \case
-    PreSymbolAlias a -> getLoc a
-    PreSymbolFinal a -> getLoc a
-
-instance HasLoc SymbolEntry where
-  getLoc = (^. symbolEntry . S.nameDefined)
-
-instance HasNameKind ModuleSymbolEntry where
-  getNameKind (ModuleSymbolEntry s) = S.getNameKind s
-
-instance HasLoc ModuleSymbolEntry where
-  getLoc (ModuleSymbolEntry s) = s ^. S.nameDefined
-
-symbolEntryNameId :: SymbolEntry -> NameId
-symbolEntryNameId = (^. symbolEntry . S.nameId)
-
-instance HasNameKind SymbolEntry where
-  getNameKind = S.getNameKind . (^. symbolEntry)
-
-preSymbolName :: Lens' PreSymbolEntry S.Name
-preSymbolName f = \case
-  PreSymbolAlias a -> PreSymbolAlias <$> traverseOf aliasName f a
-  PreSymbolFinal a -> PreSymbolFinal <$> traverseOf symbolEntry f a
-
 exportAllNames :: SimpleFold ExportInfo S.Name
 exportAllNames =
   exportSymbols

test/Compilation/Positive.hs

@@ -435,5 +435,10 @@ tests =
         "Test072: Monad transformers (ReaderT + StateT + Identity)"
         $(mkRelDir "test072")
         $(mkRelFile "ReaderT.juvix")
-        $(mkRelFile "out/test072.out")
+        $(mkRelFile "out/test072.out"),
+      posTest
+        "Test073: Import and use a syntax alias"
+        $(mkRelDir "test073")
+        $(mkRelFile "test073.juvix")
+        $(mkRelFile "out/test073.out")
     ]

tests/Compilation/positive/out/test073.out

@@ -0,0 +1 @@
+11

tests/Compilation/positive/test073/Package.juvix

@@ -0,0 +1,5 @@
+module Package;
+
+import PackageDescription.V2 open;
+
+package : Package := defaultPackage {name := "test073"};

tests/Compilation/positive/test073/SyntaxAlias.juvix

@@ -0,0 +1,5 @@
+module SyntaxAlias;
+
+import Stdlib.Prelude open;
+
+syntax alias MyNat := Nat;

tests/Compilation/positive/test073/test073.juvix

@@ -0,0 +1,5 @@
+module test073;
+
+import SyntaxAlias open;
+
+main : MyNat := 11;