From ab887e3138503ed1d8603f55bf17b09cdd9b6511 Mon Sep 17 00:00:00 2001 From: Paul Cadman Date: Wed, 31 Jan 2024 11:56:09 +0000 Subject: [PATCH] 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](https://github.com/anoma/juvix/blob/6649209d26937476a65d21bd6b1c19a109881b32/src/Juvix/Compiler/Store/Scoped/Data/InfoTable.hs#L14) and then use it to initialise the scoper state when scoping a module. --- .../Concrete/Data/InfoTableBuilder.hs | 4 + .../FromParsed/Analysis/Scoping.hs | 3 +- .../Compiler/Store/Scoped/Data/InfoTable.hs | 10 ++- .../Compiler/Store/Scoped/Data/SymbolEntry.hs | 78 ++++++++++++++++++ src/Juvix/Compiler/Store/Scoped/Language.hs | 79 ++----------------- test/Compilation/Positive.hs | 7 +- tests/Compilation/positive/out/test073.out | 1 + .../positive/test073/Package.juvix | 5 ++ .../positive/test073/SyntaxAlias.juvix | 5 ++ .../positive/test073/test073.juvix | 5 ++ 10 files changed, 119 insertions(+), 78 deletions(-) create mode 100644 src/Juvix/Compiler/Store/Scoped/Data/SymbolEntry.hs create mode 100644 tests/Compilation/positive/out/test073.out create mode 100644 tests/Compilation/positive/test073/Package.juvix create mode 100644 tests/Compilation/positive/test073/SyntaxAlias.juvix create mode 100644 tests/Compilation/positive/test073/test073.juvix diff --git a/src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs b/src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs index 5d4a9f6000..11f7ca83f4 100644 --- a/src/Juvix/Compiler/Concrete/Data/InfoTableBuilder.hs +++ b/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 diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs index 5f4950b231..36218cf9d6 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs +++ b/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 diff --git a/src/Juvix/Compiler/Store/Scoped/Data/InfoTable.hs b/src/Juvix/Compiler/Store/Scoped/Data/InfoTable.hs index 391bb3b6ca..0068cc69b9 100644 --- a/src/Juvix/Compiler/Store/Scoped/Data/InfoTable.hs +++ b/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 diff --git a/src/Juvix/Compiler/Store/Scoped/Data/SymbolEntry.hs b/src/Juvix/Compiler/Store/Scoped/Data/SymbolEntry.hs new file mode 100644 index 0000000000..05aaf1d50a --- /dev/null +++ b/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 diff --git a/src/Juvix/Compiler/Store/Scoped/Language.hs b/src/Juvix/Compiler/Store/Scoped/Language.hs index 58a270ccdc..5a709b7086 100644 --- a/src/Juvix/Compiler/Store/Scoped/Language.hs +++ b/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 diff --git a/test/Compilation/Positive.hs b/test/Compilation/Positive.hs index d4940892af..cc7c4ff7c1 100644 --- a/test/Compilation/Positive.hs +++ b/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") ] diff --git a/tests/Compilation/positive/out/test073.out b/tests/Compilation/positive/out/test073.out new file mode 100644 index 0000000000..b4de394767 --- /dev/null +++ b/tests/Compilation/positive/out/test073.out @@ -0,0 +1 @@ +11 diff --git a/tests/Compilation/positive/test073/Package.juvix b/tests/Compilation/positive/test073/Package.juvix new file mode 100644 index 0000000000..905b22a801 --- /dev/null +++ b/tests/Compilation/positive/test073/Package.juvix @@ -0,0 +1,5 @@ +module Package; + +import PackageDescription.V2 open; + +package : Package := defaultPackage {name := "test073"}; diff --git a/tests/Compilation/positive/test073/SyntaxAlias.juvix b/tests/Compilation/positive/test073/SyntaxAlias.juvix new file mode 100644 index 0000000000..1231cd99fb --- /dev/null +++ b/tests/Compilation/positive/test073/SyntaxAlias.juvix @@ -0,0 +1,5 @@ +module SyntaxAlias; + +import Stdlib.Prelude open; + +syntax alias MyNat := Nat; diff --git a/tests/Compilation/positive/test073/test073.juvix b/tests/Compilation/positive/test073/test073.juvix new file mode 100644 index 0000000000..f314df5de7 --- /dev/null +++ b/tests/Compilation/positive/test073/test073.juvix @@ -0,0 +1,5 @@ +module test073; + +import SyntaxAlias open; + +main : MyNat := 11;