From dc8d4b71754a43bc5155acee901207fb63a53e52 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?=C5=81ukasz=20Czajka?= <62751+lukaszcz@users.noreply.github.com> Date: Sun, 1 Dec 2024 18:06:10 +0100 Subject: [PATCH] Fix disappearing judoc in syntax declarations (#3205) * Closes #3063 --- .../Compiler/Concrete/Data/Scope/Base.hs | 4 +- src/Juvix/Compiler/Concrete/Language/Base.hs | 63 ++++++++++++++----- src/Juvix/Compiler/Concrete/Print/Base.hs | 28 +++++---- .../FromParsed/Analysis/Scoping.hs | 50 ++++++++++++--- .../Analysis/Scoping/Error/Types.hs | 14 ++--- .../Concrete/Translation/FromSource.hs | 11 ++-- tests/positive/Format.juvix | 14 +++++ 7 files changed, 138 insertions(+), 46 deletions(-) diff --git a/src/Juvix/Compiler/Concrete/Data/Scope/Base.hs b/src/Juvix/Compiler/Concrete/Data/Scope/Base.hs index ec8952dd12..02bd03d26e 100644 --- a/src/Juvix/Compiler/Concrete/Data/Scope/Base.hs +++ b/src/Juvix/Compiler/Concrete/Data/Scope/Base.hs @@ -70,7 +70,7 @@ data ScoperState = ScoperState data SymbolOperator = SymbolOperator { _symbolOperatorUsed :: Bool, _symbolOperatorFixity :: Fixity, - _symbolOperatorDef :: OperatorSyntaxDef + _symbolOperatorDef :: OperatorSyntaxDef 'Parsed } deriving stock (Show) @@ -81,7 +81,7 @@ newtype ScoperOperators = ScoperOperators data SymbolIterator = SymbolIterator { _symbolIteratorUsed :: Bool, - _symbolIteratorDef :: IteratorSyntaxDef + _symbolIteratorDef :: IteratorSyntaxDef 'Parsed } newtype ScoperIterators = ScoperIterators diff --git a/src/Juvix/Compiler/Concrete/Language/Base.hs b/src/Juvix/Compiler/Concrete/Language/Base.hs index a93ebe0e1e..357d393bc9 100644 --- a/src/Juvix/Compiler/Concrete/Language/Base.hs +++ b/src/Juvix/Compiler/Concrete/Language/Base.hs @@ -360,6 +360,7 @@ deriving stock instance Ord (Import 'Scoped) data AliasDef (s :: Stage) = AliasDef { _aliasDefSyntaxKw :: Irrelevant KeywordRef, _aliasDefAliasKw :: Irrelevant KeywordRef, + _aliasDefDoc :: Maybe (Judoc s), _aliasDefName :: SymbolType s, _aliasDefAsName :: IdentifierType s } @@ -398,8 +399,8 @@ instance NFData ParsedIteratorInfo data SyntaxDef (s :: Stage) = SyntaxFixity (FixitySyntaxDef s) - | SyntaxOperator OperatorSyntaxDef - | SyntaxIterator IteratorSyntaxDef + | SyntaxOperator (OperatorSyntaxDef s) + | SyntaxIterator (IteratorSyntaxDef s) | SyntaxAlias (AliasDef s) deriving stock instance (Show (SyntaxDef 'Parsed)) @@ -484,34 +485,68 @@ instance Serialize FixityDef instance NFData FixityDef -data OperatorSyntaxDef = OperatorSyntaxDef +data OperatorSyntaxDef (s :: Stage) = OperatorSyntaxDef { _opSymbol :: Symbol, _opFixity :: Symbol, + _opDoc :: Maybe (Judoc s), _opKw :: KeywordRef, _opSyntaxKw :: KeywordRef } - deriving stock (Show, Eq, Ord, Generic) + deriving stock (Generic) + +deriving stock instance Show (OperatorSyntaxDef 'Parsed) + +deriving stock instance Show (OperatorSyntaxDef 'Scoped) + +deriving stock instance Eq (OperatorSyntaxDef 'Parsed) + +deriving stock instance Eq (OperatorSyntaxDef 'Scoped) + +deriving stock instance Ord (OperatorSyntaxDef 'Parsed) + +deriving stock instance Ord (OperatorSyntaxDef 'Scoped) + +instance Serialize (OperatorSyntaxDef 'Parsed) + +instance NFData (OperatorSyntaxDef 'Parsed) -instance Serialize OperatorSyntaxDef +instance Serialize (OperatorSyntaxDef 'Scoped) -instance NFData OperatorSyntaxDef +instance NFData (OperatorSyntaxDef 'Scoped) -instance HasLoc OperatorSyntaxDef where +instance HasLoc (OperatorSyntaxDef s) where getLoc OperatorSyntaxDef {..} = getLoc _opSyntaxKw <> getLoc _opSymbol -data IteratorSyntaxDef = IteratorSyntaxDef +data IteratorSyntaxDef (s :: Stage) = IteratorSyntaxDef { _iterSymbol :: Symbol, _iterInfo :: Maybe ParsedIteratorInfo, + _iterDoc :: Maybe (Judoc s), _iterSyntaxKw :: KeywordRef, _iterIteratorKw :: KeywordRef } - deriving stock (Show, Eq, Ord, Generic) + deriving stock (Generic) + +deriving stock instance Show (IteratorSyntaxDef 'Parsed) + +deriving stock instance Show (IteratorSyntaxDef 'Scoped) + +deriving stock instance Eq (IteratorSyntaxDef 'Parsed) + +deriving stock instance Eq (IteratorSyntaxDef 'Scoped) + +deriving stock instance Ord (IteratorSyntaxDef 'Parsed) + +deriving stock instance Ord (IteratorSyntaxDef 'Scoped) + +instance Serialize (IteratorSyntaxDef 'Parsed) + +instance NFData (IteratorSyntaxDef 'Parsed) -instance Serialize IteratorSyntaxDef +instance Serialize (IteratorSyntaxDef 'Scoped) -instance NFData IteratorSyntaxDef +instance NFData (IteratorSyntaxDef 'Scoped) -instance HasLoc IteratorSyntaxDef where +instance HasLoc (IteratorSyntaxDef s) where getLoc IteratorSyntaxDef {..} = getLoc _iterSyntaxKw <> getLoc _iterSymbol data ArgDefault (s :: Stage) = ArgDefault @@ -2565,8 +2600,8 @@ deriving stock instance Ord (NamedApplicationNew 'Parsed) deriving stock instance Ord (NamedApplicationNew 'Scoped) data RecordSyntaxDef (s :: Stage) - = RecordSyntaxOperator OperatorSyntaxDef - | RecordSyntaxIterator IteratorSyntaxDef + = RecordSyntaxOperator (OperatorSyntaxDef s) + | RecordSyntaxIterator (IteratorSyntaxDef s) deriving stock (Generic) instance Serialize (RecordSyntaxDef 'Scoped) diff --git a/src/Juvix/Compiler/Concrete/Print/Base.hs b/src/Juvix/Compiler/Concrete/Print/Base.hs index 8f61ac9c28..8913d7db27 100644 --- a/src/Juvix/Compiler/Concrete/Print/Base.hs +++ b/src/Juvix/Compiler/Concrete/Print/Base.hs @@ -377,7 +377,7 @@ instance (SingI s) => PrettyPrint (NamedArgumentNew s) where NamedArgumentNewFunction f -> ppCode f NamedArgumentItemPun f -> ppCode f -instance PrettyPrint (RecordSyntaxDef s) where +instance (SingI s) => PrettyPrint (RecordSyntaxDef s) where ppCode = \case RecordSyntaxOperator d -> ppCode d RecordSyntaxIterator d -> ppCode d @@ -594,8 +594,10 @@ instance PrettyPrint ScopedIden where ppCode = ppCode . (^. scopedIdenSrcName) instance (SingI s) => PrettyPrint (AliasDef s) where - ppCode AliasDef {..} = - ppCode _aliasDefSyntaxKw + ppCode AliasDef {..} = do + let doc' = ppCode <$> _aliasDefDoc + doc' + ?<> ppCode _aliasDefSyntaxKw <+> ppCode _aliasDefAliasKw <+> ppSymbolType _aliasDefName <+> ppCode Kw.kwAssign @@ -928,15 +930,17 @@ instance (SingI s) => PrettyPrint (ParsedFixityInfo s) where instance (SingI s) => PrettyPrint (FixitySyntaxDef s) where ppCode f@FixitySyntaxDef {..} = do - let header' = ppFixityDefHeader f + let doc' = ppCode <$> _fixityDoc + header' = ppFixityDefHeader f body' = ppCode _fixityInfo - header' <+> ppCode _fixityAssignKw <+> body' + doc' ?<> header' <+> ppCode _fixityAssignKw <+> body' -instance PrettyPrint OperatorSyntaxDef where +instance (SingI s) => PrettyPrint (OperatorSyntaxDef s) where ppCode OperatorSyntaxDef {..} = do - let opSymbol' = ppUnkindedSymbol _opSymbol + let doc' = ppCode <$> _opDoc + opSymbol' = ppUnkindedSymbol _opSymbol p = ppUnkindedSymbol _opFixity - ppCode _opSyntaxKw <+> ppCode _opKw <+> opSymbol' <+> p + doc' ?<> ppCode _opSyntaxKw <+> ppCode _opKw <+> opSymbol' <+> p instance PrettyPrint PatternApp where ppCode = apeHelper @@ -965,10 +969,12 @@ instance PrettyPrint ParsedIteratorInfo where items = ppBlockOrList' (catMaybes [iniItem, rangeItem]) grouped (ppCode l <> items <> ppCode r) -instance PrettyPrint IteratorSyntaxDef where +instance (SingI s) => PrettyPrint (IteratorSyntaxDef s) where ppCode IteratorSyntaxDef {..} = do - let iterSymbol' = ppUnkindedSymbol _iterSymbol - ppCode _iterSyntaxKw + let doc' = ppCode <$> _iterDoc + iterSymbol' = ppUnkindedSymbol _iterSymbol + doc' + ?<> ppCode _iterSyntaxKw <+> ppCode _iterIteratorKw <+> iterSymbol' <+?> fmap ppCode _iterInfo diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs index 901d37ce8b..b847e6ff8a 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs @@ -1044,10 +1044,26 @@ resolveFixitySyntaxDef fdef@FixitySyntaxDef {..} = topBindings $ do getFixityId :: (Members '[InfoTableBuilder, Reader InfoTable] r') => S.Symbol -> Sem r' S.NameId getFixityId = return . fromJust . (^. fixityDefFixity . fixityId) <=< getFixityDef +checkOperatorSyntaxDef :: + forall r. + (Members '[Reader PackageId, Reader ScopeParameters, Reader InfoTable, InfoTableBuilder, NameIdGen, Error ScoperError, Reader ScopeParameters, State Scope, State ScoperState, State ScoperSyntax, NameIdGen, InfoTableBuilder, Reader InfoTable] r) => + OperatorSyntaxDef 'Parsed -> + Sem r (OperatorSyntaxDef 'Scoped) +checkOperatorSyntaxDef OperatorSyntaxDef {..} = do + mdef <- mapM checkJudoc _opDoc + return + OperatorSyntaxDef + { _opSymbol = _opSymbol, + _opDoc = mdef, + _opFixity = _opFixity, + _opSyntaxKw = _opSyntaxKw, + _opKw = _opKw + } + resolveOperatorSyntaxDef :: forall r. (Members '[Error ScoperError, State Scope, State ScoperState, State ScoperSyntax, InfoTableBuilder, Reader InfoTable] r) => - OperatorSyntaxDef -> + OperatorSyntaxDef 'Parsed -> Sem r () resolveOperatorSyntaxDef s@OperatorSyntaxDef {..} = do checkNotDefined @@ -1067,10 +1083,26 @@ resolveOperatorSyntaxDef s@OperatorSyntaxDef {..} = do (HashMap.lookup _opSymbol <$> gets (^. scoperSyntaxOperators . scoperOperators)) $ \s' -> throw (ErrDuplicateOperator (DuplicateOperator (s' ^. symbolOperatorDef) s)) +checkIteratorSyntaxDef :: + forall r. + (Members '[Reader PackageId, Reader ScopeParameters, Reader InfoTable, InfoTableBuilder, NameIdGen, Error ScoperError, Reader ScopeParameters, State Scope, State ScoperState, State ScoperSyntax, NameIdGen, InfoTableBuilder, Reader InfoTable] r) => + IteratorSyntaxDef 'Parsed -> + Sem r (IteratorSyntaxDef 'Scoped) +checkIteratorSyntaxDef IteratorSyntaxDef {..} = do + doc <- mapM checkJudoc _iterDoc + return + IteratorSyntaxDef + { _iterSymbol = _iterSymbol, + _iterDoc = doc, + _iterInfo = _iterInfo, + _iterIteratorKw, + _iterSyntaxKw + } + resolveIteratorSyntaxDef :: forall r. (Members '[Error ScoperError, State Scope, State ScoperState, State ScoperSyntax] r) => - IteratorSyntaxDef -> + IteratorSyntaxDef 'Parsed -> Sem r () resolveIteratorSyntaxDef s@IteratorSyntaxDef {..} = do checkNotDefined @@ -1362,8 +1394,8 @@ checkInductiveDef InductiveDef {..} = do checkRecordSyntaxDef :: RecordSyntaxDef 'Parsed -> Sem r (RecordSyntaxDef 'Scoped) checkRecordSyntaxDef = \case - RecordSyntaxOperator d -> return (RecordSyntaxOperator d) - RecordSyntaxIterator d -> return (RecordSyntaxIterator d) + RecordSyntaxOperator d -> RecordSyntaxOperator <$> checkOperatorSyntaxDef d + RecordSyntaxIterator d -> RecordSyntaxIterator <$> checkIteratorSyntaxDef d checkRecordStatement :: RecordStatement 'Parsed -> Sem r (RecordStatement 'Scoped) checkRecordStatement = \case @@ -3247,22 +3279,24 @@ checkSyntaxDef :: checkSyntaxDef = \case SyntaxFixity fixDef -> SyntaxFixity <$> checkFixitySyntaxDef fixDef SyntaxAlias a -> SyntaxAlias <$> checkAliasDef a - SyntaxOperator opDef -> return $ SyntaxOperator opDef - SyntaxIterator iterDef -> return $ SyntaxIterator iterDef + SyntaxOperator opDef -> SyntaxOperator <$> checkOperatorSyntaxDef opDef + SyntaxIterator iterDef -> SyntaxIterator <$> checkIteratorSyntaxDef iterDef checkAliasDef :: forall r. - (Members '[Error ScoperError, Reader ScopeParameters, State Scope, State ScoperState, Reader BindingStrategy, InfoTableBuilder, Reader InfoTable, NameIdGen, State ScoperSyntax] r) => + (Members '[Reader PackageId, Reader ScopeParameters, Reader InfoTable, InfoTableBuilder, NameIdGen, Error ScoperError, Reader ScopeParameters, State Scope, State ScoperState, Reader BindingStrategy, InfoTableBuilder, Reader InfoTable, NameIdGen, State ScoperSyntax] r) => AliasDef 'Parsed -> Sem r (AliasDef 'Scoped) checkAliasDef def@AliasDef {..} = do scanAlias def + doc' <- maybe (return Nothing) (return . Just <=< checkJudoc) _aliasDefDoc aliasName' :: S.Symbol <- gets (^?! scopeLocalSymbols . at _aliasDefName . _Just) asName' <- checkScopedIden _aliasDefAsName return AliasDef { _aliasDefName = aliasName', _aliasDefAsName = asName', + _aliasDefDoc = doc', .. } where @@ -3281,7 +3315,7 @@ reserveAliasDef :: reserveAliasDef = void . reserveAliasSymbol resolveSyntaxDef :: - (Members '[Error ScoperError, Reader ScopeParameters, State Scope, State ScoperState, InfoTableBuilder, Reader InfoTable, NameIdGen, State ScoperSyntax, Reader BindingStrategy] r) => + (Members '[Reader PackageId, Reader ScopeParameters, Reader InfoTable, InfoTableBuilder, NameIdGen, Error ScoperError, Reader ScopeParameters, State Scope, State ScoperState, InfoTableBuilder, Reader InfoTable, NameIdGen, State ScoperSyntax, Reader BindingStrategy] r) => SyntaxDef 'Parsed -> Sem r () resolveSyntaxDef = \case diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs index ac71598a84..6d0d1986e7 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping/Error/Types.hs @@ -210,8 +210,8 @@ instance ToGenericError QualSymNotInScope where msg = "Qualified symbol not in scope:" <+> ppCode opts' _qualSymNotInScope data DuplicateOperator = DuplicateOperator - { _dupOperatorFirst :: OperatorSyntaxDef, - _dupOperatorSecond :: OperatorSyntaxDef + { _dupOperatorFirst :: OperatorSyntaxDef 'Parsed, + _dupOperatorSecond :: OperatorSyntaxDef 'Parsed } deriving stock (Show) @@ -241,8 +241,8 @@ instance ToGenericError DuplicateOperator where locs = vsep $ map (pretty . getLoc) [_dupOperatorFirst, _dupOperatorSecond] data DuplicateIterator = DuplicateIterator - { _dupIteratorFirst :: IteratorSyntaxDef, - _dupIteratorSecond :: IteratorSyntaxDef + { _dupIteratorFirst :: IteratorSyntaxDef 'Parsed, + _dupIteratorSecond :: IteratorSyntaxDef 'Parsed } deriving stock (Show) @@ -426,7 +426,7 @@ instance ToGenericError ModuleNotInScope where msg = "The module" <+> ppCode opts' _moduleNotInScopeName <+> "is not in scope" newtype UnusedOperatorDef = UnusedOperatorDef - { _unusedOperatorDef :: OperatorSyntaxDef + { _unusedOperatorDef :: OperatorSyntaxDef 'Parsed } deriving stock (Show) @@ -449,7 +449,7 @@ instance ToGenericError UnusedOperatorDef where <> ppCode opts' _unusedOperatorDef newtype UnusedIteratorDef = UnusedIteratorDef - { _unusedIteratorDef :: IteratorSyntaxDef + { _unusedIteratorDef :: IteratorSyntaxDef 'Parsed } deriving stock (Show) @@ -741,7 +741,7 @@ instance ToGenericError IteratorInitializer where i = getLoc _iteratorInitializerIterator newtype InvalidRangeNumber = InvalidRangeNumber - { _invalidRangeNumber :: IteratorSyntaxDef + { _invalidRangeNumber :: IteratorSyntaxDef 'Parsed } deriving stock (Show) diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs index 744a2f17c1..19a5003b26 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs @@ -705,6 +705,7 @@ aliasDef :: forall r. (Members '[ParserResultBuilder, PragmasStash, Error Parser aliasDef synKw = do let _aliasDefSyntaxKw = Irrelevant synKw _aliasDefAliasKw <- Irrelevant <$> kw kwAlias + _aliasDefDoc <- getJudoc _aliasDefName <- symbol kw kwAssign _aliasDefAsName <- name @@ -770,16 +771,17 @@ parsedFixityInfo = do fixitySyntaxDef :: forall r. (Members '[ParserResultBuilder, PragmasStash, Error ParserError, JudocStash] r) => KeywordRef -> ParsecS r (FixitySyntaxDef 'Parsed) fixitySyntaxDef _fixitySyntaxKw = P.label "" $ do - _fixityDoc <- getJudoc _fixityKw <- kw kwFixity + _fixityDoc <- getJudoc _fixitySymbol <- symbol _fixityAssignKw <- kw kwAssign _fixityInfo <- parsedFixityInfo return FixitySyntaxDef {..} -operatorSyntaxDef :: forall r. (Members '[ParserResultBuilder, PragmasStash, Error ParserError, JudocStash] r) => KeywordRef -> ParsecS r OperatorSyntaxDef -operatorSyntaxDef _opSyntaxKw = do +operatorSyntaxDef :: forall r. (Members '[ParserResultBuilder, PragmasStash, Error ParserError, JudocStash] r) => KeywordRef -> ParsecS r (OperatorSyntaxDef 'Parsed) +operatorSyntaxDef _opSyntaxKw = P.label "" $ do _opKw <- kw kwOperator + _opDoc <- getJudoc _opSymbol <- symbol _opFixity <- symbol return OperatorSyntaxDef {..} @@ -810,9 +812,10 @@ parsedIteratorInfo = do void (kw kwRange >> kw kwAssign) fmap fromIntegral <$> integer -iteratorSyntaxDef :: forall r. (Members '[ParserResultBuilder, PragmasStash, Error ParserError, JudocStash] r) => KeywordRef -> ParsecS r IteratorSyntaxDef +iteratorSyntaxDef :: forall r. (Members '[ParserResultBuilder, PragmasStash, Error ParserError, JudocStash] r) => KeywordRef -> ParsecS r (IteratorSyntaxDef 'Parsed) iteratorSyntaxDef _iterSyntaxKw = do _iterIteratorKw <- kw kwIterator + _iterDoc <- getJudoc _iterSymbol <- symbol _iterInfo <- optional parsedIteratorInfo return IteratorSyntaxDef {..} diff --git a/tests/positive/Format.juvix b/tests/positive/Format.juvix index 5c52cf9121..f88662135b 100644 --- a/tests/positive/Format.juvix +++ b/tests/positive/Format.juvix @@ -530,4 +530,18 @@ module PublicImports; axiom a : Inner.X.Y.Z.Nat; end; +--- Judoc comment 0 +syntax fixity aaa := binary {}; + +--- Judoc comment 1 +syntax alias Value := Nat; + +--- Judoc comment 2 +syntax iterator op; + +--- Judoc comment 3 +syntax operator op aaa; +--- Judoc comment 4 +op (x y : Nat) : Nat := x + y; + -- Comment at the end of a module