From dd8457d0974953d06036a0533338f8da80345a21 Mon Sep 17 00:00:00 2001 From: janmasrovira Date: Thu, 16 Feb 2023 12:05:49 +0100 Subject: [PATCH] Remove module parameters (#1848) --- .../Abstract/Translation/FromConcrete.hs | 20 ++++----- src/Juvix/Compiler/Concrete/Language.hs | 2 - src/Juvix/Compiler/Concrete/Pretty/Base.hs | 24 +++------- src/Juvix/Compiler/Concrete/Print/Base.hs | 2 - .../FromParsed/Analysis/Scoping.hs | 44 ++++++++----------- 5 files changed, 35 insertions(+), 57 deletions(-) diff --git a/src/Juvix/Compiler/Abstract/Translation/FromConcrete.hs b/src/Juvix/Compiler/Abstract/Translation/FromConcrete.hs index 424815e95..f7825b751 100644 --- a/src/Juvix/Compiler/Abstract/Translation/FromConcrete.hs +++ b/src/Juvix/Compiler/Abstract/Translation/FromConcrete.hs @@ -69,17 +69,15 @@ goModule m = case sing :: SModuleIsTop t of SModuleLocal -> goModule' m where goModule' :: Module 'Scoped t -> Sem r Abstract.Module - goModule' Module {..} - | null _moduleParameters = do - body' <- goModuleBody _moduleBody - examples' <- goExamples _moduleDoc - return - Abstract.Module - { _moduleName = name', - _moduleBody = body', - _moduleExamples = examples' - } - | otherwise = unsupported "Module parameters" + goModule' Module {..} = do + body' <- goModuleBody _moduleBody + examples' <- goExamples _moduleDoc + return + Abstract.Module + { _moduleName = name', + _moduleBody = body', + _moduleExamples = examples' + } where name' :: Abstract.Name name' = case sing :: SModuleIsTop t of diff --git a/src/Juvix/Compiler/Concrete/Language.hs b/src/Juvix/Compiler/Concrete/Language.hs index 1ad8e97ed..a71d1b561 100644 --- a/src/Juvix/Compiler/Concrete/Language.hs +++ b/src/Juvix/Compiler/Concrete/Language.hs @@ -398,7 +398,6 @@ type LocalModuleName s = SymbolType s data Module (s :: Stage) (t :: ModuleIsTop) = Module { _moduleKw :: KeywordRef, _modulePath :: ModulePathType s t, - _moduleParameters :: [InductiveParameters s], _moduleDoc :: Maybe (Judoc s), _moduleBody :: [Statement s] } @@ -511,7 +510,6 @@ data OpenModule (s :: Stage) = OpenModule { _openModuleKw :: KeywordRef, _openModuleName :: ModuleRefType s, _openModuleImportKw :: Maybe KeywordRef, - _openParameters :: [ExpressionType s], _openUsingHiding :: Maybe UsingHiding, _openPublic :: PublicAnn } diff --git a/src/Juvix/Compiler/Concrete/Pretty/Base.hs b/src/Juvix/Compiler/Concrete/Pretty/Base.hs index 5de577967..47455135c 100644 --- a/src/Juvix/Compiler/Concrete/Pretty/Base.hs +++ b/src/Juvix/Compiler/Concrete/Pretty/Base.hs @@ -208,19 +208,17 @@ instance (SingI s, SingI t) => PrettyCode (Module s t) where ppCode Module {..} = do moduleBody' <- indent' <$> ppCode _moduleBody modulePath' <- ppModulePathType _modulePath - moduleParameters' <- ppInductiveParameters _moduleParameters moduleDoc' <- mapM ppCode _moduleDoc return $ moduleDoc' ?<> kwModule <+> modulePath' - <+?> moduleParameters' - <> kwSemicolon - <> line - <> moduleBody' - <> line - <> kwEnd - <>? lastSemicolon + <> kwSemicolon + <> line + <> moduleBody' + <> line + <> kwEnd + <>? lastSemicolon where lastSemicolon = case sing :: SModuleIsTop t of SModuleLocal -> Nothing @@ -368,18 +366,10 @@ instance (SingI s) => PrettyCode (OpenModule s) where SParsed -> ppCode _openModuleName SScoped -> ppCode _openModuleName openUsingHiding' <- mapM ppUsingHiding _openUsingHiding - openParameters' <- ppOpenParams importkw' <- mapM ppCode _openModuleImportKw let openPublic' = ppPublic - return $ kwOpen <+?> importkw' <+> openModuleName' <+?> openParameters' <+?> openUsingHiding' <+?> openPublic' + return $ kwOpen <+?> importkw' <+> openModuleName' <+?> openUsingHiding' <+?> openPublic' where - ppAtom' = case sing :: SStage s of - SParsed -> ppCodeAtom - SScoped -> ppCodeAtom - ppOpenParams :: Sem r (Maybe (Doc Ann)) - ppOpenParams = case _openParameters of - [] -> return Nothing - _ -> Just . hsep <$> mapM ppAtom' _openParameters ppUsingHiding :: UsingHiding -> Sem r (Doc Ann) ppUsingHiding uh = do bracedList <- diff --git a/src/Juvix/Compiler/Concrete/Print/Base.hs b/src/Juvix/Compiler/Concrete/Print/Base.hs index 207e418a1..9feb34b94 100644 --- a/src/Juvix/Compiler/Concrete/Print/Base.hs +++ b/src/Juvix/Compiler/Concrete/Print/Base.hs @@ -252,7 +252,6 @@ instance PrettyPrint (OpenModule 'Scoped) where ppCode OpenModule {..} = do let name' = ppCode _openModuleName usingHiding' = ppCode <$> _openUsingHiding - openParameters' = hsep . fmap ppAtom <$> nonEmpty _openParameters importkw' = ppCode <$> _openModuleImportKw public' = case _openPublic of Public -> Just (noLoc P.kwPublic) @@ -260,7 +259,6 @@ instance PrettyPrint (OpenModule 'Scoped) where ppCode _openModuleKw <+?> importkw' <+> name' - <+?> openParameters' <+?> usingHiding' <+?> public' diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs index 558a2d36a..b1243f26a 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs @@ -533,7 +533,7 @@ checkTopModule :: (Members '[Error ScoperError, Reader ScopeParameters, State ScoperState, InfoTableBuilder, NameIdGen] r) => Module 'Parsed 'ModuleTop -> Sem r (ModuleRef'' 'S.NotConcrete 'ModuleTop) -checkTopModule m@(Module _moduleKw path params doc body) = do +checkTopModule m@(Module _moduleKw path doc body) = do r <- checkedModule modify (over (scoperModulesCache . cachedModules) (HashMap.insert path r)) registerModule (r ^. moduleRefModule) @@ -563,20 +563,18 @@ checkTopModule m@(Module _moduleKw path params doc body) = do checkedModule = do (s, (m', p)) <- runState iniScope $ do path' <- freshTopModulePath - localScope $ - withParams params $ \params' -> do - (_moduleExportInfo, body') <- checkModuleBody body - doc' <- mapM checkJudoc doc - let _moduleRefModule = - Module - { _modulePath = path', - _moduleParameters = params', - _moduleBody = body', - _moduleDoc = doc', - _moduleKw - } - _moduleRefName = set S.nameConcrete () path' - return (ModuleRef'' {..}, path') + localScope $ do + (_moduleExportInfo, body') <- checkModuleBody body + doc' <- mapM checkJudoc doc + let _moduleRefModule = + Module + { _modulePath = path', + _moduleBody = body', + _moduleDoc = doc', + _moduleKw + } + _moduleRefName = set S.nameConcrete () path' + return (ModuleRef'' {..}, path') modify (set (scoperScope . at (p ^. S.nameConcrete)) (Just s)) return m' @@ -604,20 +602,18 @@ checkLocalModule :: Module 'Parsed 'ModuleLocal -> Sem r (Module 'Scoped 'ModuleLocal) checkLocalModule Module {..} = do - (_moduleExportInfo, moduleBody', moduleParameters', moduleDoc') <- - withScope $ - withParams _moduleParameters $ \p' -> do - inheritScope - (e, b) <- checkModuleBody _moduleBody - doc' <- mapM checkJudoc _moduleDoc - return (e, b, p', doc') + (_moduleExportInfo, moduleBody', moduleDoc') <- + withScope $ do + inheritScope + (e, b) <- checkModuleBody _moduleBody + doc' <- mapM checkJudoc _moduleDoc + return (e, b, doc') _modulePath' <- reserveSymbolOf S.KNameLocalModule _modulePath let moduleId = _modulePath' ^. S.nameId _moduleRefName = set S.nameConcrete () _modulePath' _moduleRefModule = Module { _modulePath = _modulePath', - _moduleParameters = moduleParameters', _moduleBody = moduleBody', _moduleDoc = moduleDoc', _moduleKw @@ -710,13 +706,11 @@ checkOpenModuleNoImport OpenModule {..} | isJust _openModuleImportKw = error "unsupported: open import statement" | otherwise = do openModuleName'@(ModuleRef' (_ :&: moduleRef'')) <- lookupModuleSymbol _openModuleName - openParameters' <- mapM checkParseExpressionAtoms _openParameters mergeScope (alterScope (moduleRef'' ^. moduleExportInfo)) registerName (moduleRef'' ^. moduleRefName) return OpenModule { _openModuleName = openModuleName', - _openParameters = openParameters', .. } where