From 3a165c04c22d923fee5cbf284a9b679ff07464d0 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Sat, 8 Jun 2024 11:45:41 +0200 Subject: [PATCH] parsing --- .../Backend/Html/Translation/FromTyped.hs | 4 +- src/Juvix/Compiler/Concrete/Language.hs | 41 ++++++++++++++----- src/Juvix/Compiler/Concrete/Print/Base.hs | 3 +- .../FromParsed/Analysis/Scoping.hs | 10 +++-- .../Concrete/Translation/FromSource.hs | 14 +++---- src/Juvix/Compiler/Pipeline/Package/Loader.hs | 23 +++++------ 6 files changed, 58 insertions(+), 37 deletions(-) diff --git a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs index 744e10c9f7..aa5f66bacd 100644 --- a/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs +++ b/src/Juvix/Compiler/Backend/Html/Translation/FromTyped.hs @@ -498,12 +498,12 @@ goLocalModule def = fmap (fromMaybe mempty) . runFail $ do goImport :: forall r. (Members '[Reader HtmlOptions] r) => Import 'Scoped -> Sem r Html goImport op - | Just Public {} <- op ^? importOpen . _Just . openPublic = noDefHeader <$> ppCodeHtml defaultOptions op + | Just Public {} <- op ^? importPublic = noDefHeader <$> ppCodeHtml defaultOptions op | otherwise = mempty goOpen :: forall r. (Members '[Reader HtmlOptions] r) => OpenModule 'Scoped -> Sem r Html goOpen op - | Public {} <- op ^. openModuleParams . openPublic = noDefHeader <$> ppCodeHtml defaultOptions op + | Public {} <- op ^. openModulePublic = noDefHeader <$> ppCodeHtml defaultOptions op | otherwise = mempty goAxiom :: forall r. (Members '[Reader HtmlOptions] r) => AxiomDef 'Scoped -> Sem r Html diff --git a/src/Juvix/Compiler/Concrete/Language.hs b/src/Juvix/Compiler/Concrete/Language.hs index b86e7b9f67..0d1ad16e3e 100644 --- a/src/Juvix/Compiler/Concrete/Language.hs +++ b/src/Juvix/Compiler/Concrete/Language.hs @@ -301,7 +301,8 @@ data Import (s :: Stage) = Import { _importKw :: KeywordRef, _importModulePath :: ModulePathType s 'ModuleTop, _importAsName :: Maybe (ModulePathType s 'ModuleTop), - _importOpen :: Maybe (OpenModuleParams s) + _importOpen :: Maybe (OpenModuleParams s), + _importPublic :: PublicAnn } deriving stock instance Show (Import 'Parsed) @@ -1354,7 +1355,8 @@ getNameRefId = case sing :: S.SIsConcrete c of data OpenModule (s :: Stage) = OpenModule { _openModuleName :: ModuleNameType s, - _openModuleParams :: OpenModuleParams s + _openModuleParams :: OpenModuleParams s, + _openModulePublic :: PublicAnn } deriving stock (Generic) @@ -1380,8 +1382,7 @@ deriving stock instance Ord (OpenModule 'Scoped) data OpenModuleParams (s :: Stage) = OpenModuleParams { _openModuleKw :: KeywordRef, - _openUsingHiding :: Maybe (UsingHiding s), - _openPublic :: PublicAnn + _openUsingHiding :: Maybe (UsingHiding s) } deriving stock (Generic) @@ -2665,9 +2666,9 @@ instance (SingI s) => HasLoc (AxiomDef s) where getLoc m = getLoc (m ^. axiomKw) <> getLocExpressionType (m ^. axiomType) instance HasLoc (OpenModule 'Scoped) where - getLoc m = - getLoc (m ^. openModuleParams . openModuleKw) - <>? fmap getLoc (m ^? openModuleParams . openPublic . _Public . _Just) + getLoc OpenModule {..} = + getLoc (_openModuleParams ^. openModuleKw) + <>? fmap getLoc (_openModulePublic ^? _Public . _Just) instance HasLoc (ProjectionDef s) where getLoc = getLoc . (^. projectionConstructor) @@ -2800,10 +2801,30 @@ getLocIdentifierType e = case sing :: SStage s of instance (SingI s) => HasLoc (Iterator s) where getLoc Iterator {..} = getLocIdentifierType _iteratorName <> getLocExpressionType _iteratorBody +instance HasLoc (HidingList s) where + getLoc HidingList {..} = + let rbra = _hidingBraces ^. unIrrelevant . _2 + in getLoc (_hidingKw ^. unIrrelevant) <> getLoc rbra + +instance HasLoc (UsingList s) where + getLoc UsingList {..} = + let rbra = _usingBraces ^. unIrrelevant . _2 + in getLoc (_usingKw ^. unIrrelevant) <> getLoc rbra + +instance HasLoc (UsingHiding s) where + getLoc = \case + Using u -> getLoc u + Hiding u -> getLoc u + +instance HasLoc (OpenModuleParams s) where + getLoc OpenModuleParams {..} = getLoc _openModuleKw <>? (getLoc <$> _openUsingHiding) + instance (SingI s) => HasLoc (Import s) where - getLoc Import {..} = case sing :: SStage s of - SParsed -> getLoc _importKw - SScoped -> getLoc _importKw + getLoc Import {..} = + let sLoc = case sing :: SStage s of + SParsed -> getLoc _importKw <> getLoc _importModulePath <>? (getLoc <$> _importOpen) + SScoped -> getLoc _importKw <> getLoc _importModulePath <>? (getLoc <$> _importOpen) + in sLoc <>? fmap getLoc (_importPublic ^? _Public . _Just) instance (SingI s, SingI t) => HasLoc (Module s t) where getLoc m = case sing :: SStage s of diff --git a/src/Juvix/Compiler/Concrete/Print/Base.hs b/src/Juvix/Compiler/Concrete/Print/Base.hs index a18b4e33e1..5c0aa8e013 100644 --- a/src/Juvix/Compiler/Concrete/Print/Base.hs +++ b/src/Juvix/Compiler/Concrete/Print/Base.hs @@ -1162,6 +1162,7 @@ instance (SingI s) => PrettyPrint (Import s) where <+> ppModulePathType (i ^. importModulePath) <+?> ppAlias <+?> open' + <+?> fmap ppCode (i ^? importPublic . _Public . _Just) where ppAlias :: Maybe (Sem r ()) ppAlias = case i ^. importAsName of @@ -1173,11 +1174,9 @@ ppOpenModuleHelper modName OpenModuleParams {..} = do let name' = ppModuleNameType <$> modName usingHiding' = ppCode <$> _openUsingHiding openkw = ppCode _openModuleKw - public' = ppCode <$> _openPublic ^? _Public . _Just openkw <+?> name' <+?> usingHiding' - <+?> public' instance (SingI s) => PrettyPrint (OpenModule s) where ppCode :: forall r. (Members '[ExactPrint, Reader Options] r) => OpenModule s -> Sem r () diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs index 617c7eb6a1..f2d5480ad7 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs @@ -418,7 +418,7 @@ checkImport import_@Import {..} = do registerName importName whenJust synonymName registerName registerScoperModules cmodule - importOpen' <- mapM (checkImportOpenParams cmodule) _importOpen + importOpen' <- mapM (checkImportOpenParams cmodule _importPublic) _importOpen return Import { _importModulePath = sname, @@ -1621,15 +1621,17 @@ checkImportOpenParams :: forall r. (Members '[Error ScoperError, State Scope, State ScoperState, InfoTableBuilder, Reader InfoTable, NameIdGen] r) => ScopedModule -> + PublicAnn -> OpenModuleParams 'Parsed -> Sem r (OpenModuleParams 'Scoped) -checkImportOpenParams m p = +checkImportOpenParams m pub p = (^. openModuleParams) <$> checkOpenModuleHelper (Just m) OpenModule { _openModuleParams = p, - _openModuleName = m ^. scopedModuleName . S.nameConcrete + _openModuleName = m ^. scopedModuleName . S.nameConcrete, + _openModulePublic = pub } checkOpenModule :: @@ -1762,7 +1764,7 @@ checkOpenModuleHelper importModuleHint OpenModule {..} = do over nsEntry ( set S.nameWhyInScope S.BecauseImportedOpened - . set S.nameVisibilityAnn (publicAnnToVis (_openModuleParams ^. openPublic)) + . set S.nameVisibilityAnn (publicAnnToVis _openModulePublic) ) publicAnnToVis :: PublicAnn -> VisibilityAnn diff --git a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs index 13819b2c83..01af6f41ee 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromSource.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromSource.hs @@ -792,6 +792,7 @@ import_ = do _importModulePath <- topModulePath _importAsName <- optional pasName _importOpen <- optional popenModuleParams + _importPublic <- publicAnn let i = Import {..} P.lift (registerImport i) return i @@ -1620,14 +1621,16 @@ atomicExpression = do _ -> return () return $ ExpressionAtoms (NonEmpty.singleton atom) (Irrelevant loc) +publicAnn :: forall r. (Members '[ParserResultBuilder] r) => ParsecS r PublicAnn +publicAnn = maybe NoPublic (Public . Irrelevant . Just) <$> optional (kw kwPublic) + openModule :: forall r. (Members '[ParserResultBuilder, PragmasStash, JudocStash] r) => ParsecS r (OpenModule 'Parsed) openModule = do _openModuleKw <- kw kwOpen _openModuleName <- name _openUsingHiding <- optional usingOrHiding - openPublicKw <- optional (kw kwPublic) - let _openPublic = maybe NoPublic (Public . Irrelevant . Just) openPublicKw - _openModuleParams = OpenModuleParams {..} + _openModulePublic <- publicAnn + let _openModuleParams = OpenModuleParams {..} return OpenModule {..} -- TODO is there way to merge this with `openModule`? @@ -1635,10 +1638,7 @@ popenModuleParams :: forall r. (Members '[Error ParserError, ParserResultBuilder popenModuleParams = do _openModuleKw <- kw kwOpen _openUsingHiding <- optional usingOrHiding - _openPublicKw <- Irrelevant <$> optional (kw kwPublic) - openPublicKw <- optional (kw kwPublic) - let _openPublic = maybe NoPublic (Public . Irrelevant . Just) openPublicKw - _openModuleParams = OpenModuleParams {..} + let _openModuleParams = OpenModuleParams {..} return OpenModuleParams {..} usingOrHiding :: (Members '[ParserResultBuilder, JudocStash, PragmasStash] r) => ParsecS r (UsingHiding 'Parsed) diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader.hs b/src/Juvix/Compiler/Pipeline/Package/Loader.hs index 1842831ba0..0d8d7f3ffb 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader.hs @@ -108,20 +108,19 @@ toConcrete t p = run . runReader l $ do mkImport _importModulePath = do _openModuleKw <- kw kwOpen _importKw <- kw kwImport - return - ( StatementImport - Import - { _importOpen = - Just - OpenModuleParams - { _openUsingHiding = Nothing, - _openPublic = NoPublic, - .. - }, - _importAsName = Nothing, + let openParams = + OpenModuleParams + { _openUsingHiding = Nothing, .. } - ) + return $ + StatementImport + Import + { _importOpen = Just openParams, + _importPublic = NoPublic, + _importAsName = Nothing, + .. + } mkStdlibImport :: (Member (Reader Interval) r) => Sem r (Statement 'Parsed) mkStdlibImport = do