Qualified imports (#2004)

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

@@ -86,7 +86,7 @@ topModulePathToName (TopModulePath ms m) = case nonEmpty ms of
 
 topModulePathToDottedPath :: IsString s => TopModulePath -> s
 topModulePathToDottedPath (TopModulePath l r) =
-  fromText $ mconcat $ intersperse "." $ map (^. symbolText) $ l ++ [r]
+  fromText . mconcat . intersperse "." . map (^. symbolText) $ l ++ [r]
 
 moduleNameToTopModulePath :: Name -> TopModulePath
 moduleNameToTopModulePath = \case

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

@@ -31,7 +31,11 @@ data BindingStrategy
 data Scope = Scope
   { _scopePath :: S.AbsModulePath,
     _scopeSymbols :: HashMap Symbol SymbolInfo,
-    _scopeTopModules :: HashMap TopModulePath (ModuleRef'' 'S.NotConcrete 'ModuleTop),
+    -- | The map from S.NameId to Modules is needed because we support merging
+    -- several imports under the same name. E.g.
+    -- import A as X;
+    -- import B as X;
+    _scopeTopModules :: HashMap TopModulePath (HashMap S.NameId (ModuleRef'' 'S.NotConcrete 'ModuleTop)),
     -- | Symbols that have been defined in the current scope level. Every symbol
     -- should map to itself. This is needed because we may query it with a
     -- symbol with a different location but we may want the location of the

src/Juvix/Compiler/Concrete/Keywords.hs

@@ -10,6 +10,7 @@ import Juvix.Data.Keyword.All
   ( -- reserved
 
     -- extra
+    kwAs,
     kwAssign,
     kwAt,
     kwAxiom,
@@ -77,3 +78,10 @@ allKeywords =
     kwWhere,
     kwWildcard
   ]
+
+-- | Keywords that do not need to be reserved. Currently only for documentation
+-- purposes
+nonKeywords :: [Keyword]
+nonKeywords =
+  [ kwAs
+  ]

src/Juvix/Compiler/Concrete/Language.hs

@@ -124,6 +124,7 @@ data Statement (s :: Stage)
 deriving stock instance
   ( Show (ImportType s),
     Show (ModulePathType s 'ModuleLocal),
+    Show (ModulePathType s 'ModuleTop),
     Show (PatternType s),
     Show (SymbolType s),
     Show (IdentifierType s),
@@ -136,6 +137,7 @@ deriving stock instance
   ( Eq (ImportType s),
     Eq (PatternType s),
     Eq (ModulePathType s 'ModuleLocal),
+    Eq (ModulePathType s 'ModuleTop),
     Eq (SymbolType s),
     Eq (IdentifierType s),
     Eq (ModuleRefType s),
@@ -147,6 +149,7 @@ deriving stock instance
   ( Ord (ImportType s),
     Ord (PatternType s),
     Ord (ModulePathType s 'ModuleLocal),
+    Ord (ModulePathType s 'ModuleTop),
     Ord (SymbolType s),
     Ord (IdentifierType s),
     Ord (ModuleRefType s),
@@ -160,14 +163,15 @@ deriving stock instance
 
 data Import (s :: Stage) = Import
   { _importKw :: KeywordRef,
-    _importModule :: ImportType s
+    _importModule :: ImportType s,
+    _importAsName :: Maybe (ModulePathType s 'ModuleTop)
   }
 
-deriving stock instance (Show (ImportType s)) => Show (Import s)
+deriving stock instance (Show (ModulePathType s 'ModuleTop), Show (ImportType s)) => Show (Import s)
 
-deriving stock instance (Eq (ImportType s)) => Eq (Import s)
+deriving stock instance (Eq (ModulePathType s 'ModuleTop), Eq (ImportType s)) => Eq (Import s)
 
-deriving stock instance (Ord (ImportType s)) => Ord (Import s)
+deriving stock instance (Ord (ModulePathType s 'ModuleTop), Ord (ImportType s)) => Ord (Import s)
 
 --------------------------------------------------------------------------------
 -- Operator syntax declaration
@@ -408,6 +412,7 @@ data Module (s :: Stage) (t :: ModuleIsTop) = Module
 deriving stock instance
   ( Show (ModulePathType s t),
     Show (ModulePathType s 'ModuleLocal),
+    Show (ModulePathType s 'ModuleTop),
     Show (ImportType s),
     Show (PatternType s),
     Show (IdentifierType s),
@@ -421,6 +426,7 @@ deriving stock instance
 deriving stock instance
   ( Eq (ModulePathType s t),
     Eq (ModulePathType s 'ModuleLocal),
+    Eq (ModulePathType s 'ModuleTop),
     Eq (ImportType s),
     Eq (PatternType s),
     Eq (IdentifierType s),
@@ -434,6 +440,7 @@ deriving stock instance
 deriving stock instance
   ( Ord (ModulePathType s t),
     Ord (ModulePathType s 'ModuleLocal),
+    Ord (ModulePathType s 'ModuleTop),
     Ord (ImportType s),
     Ord (PatternType s),
     Ord (IdentifierType s),

src/Juvix/Compiler/Concrete/Pretty/Base.hs

@@ -512,8 +512,15 @@ instance SingI s => PrettyCode (Import s) where
   ppCode :: forall r. Members '[Reader Options] r => Import s -> Sem r (Doc Ann)
   ppCode i = do
     modulePath' <- ppModulePath
-    return $ kwImport <+> modulePath'
+    qual' <- ppQual
+    return $ kwImport <+> modulePath' <+?> qual'
     where
+      ppQual :: Sem r (Maybe (Doc Ann))
+      ppQual = case i ^. importAsName of
+        Nothing -> return Nothing
+        Just as -> do
+          syn <- ppTopModulePath as
+          return . Just $ kwAs <+> syn
       ppModulePath = case sing :: SStage s of
         SParsed -> ppCode (i ^. importModule)
         SScoped -> ppCode (i ^. importModule)

src/Juvix/Compiler/Concrete/Print/Base.hs

@@ -119,10 +119,16 @@ instance PrettyPrint (ModuleRef'' 'S.Concrete 'ModuleTop) where
   ppCode m = ppCode (m ^. moduleRefName)
 
 instance PrettyPrint (Import 'Scoped) where
-  ppCode :: Members '[ExactPrint, Reader Options] r => Import 'Scoped -> Sem r ()
+  ppCode :: forall r. Members '[ExactPrint, Reader Options] r => Import 'Scoped -> Sem r ()
   ppCode i = do
     ppCode (i ^. importKw)
       <+> ppCode (i ^. importModule)
+      <+?> ppQual
+    where
+      ppQual :: Maybe (Sem r ())
+      ppQual = case i ^. importAsName of
+        Nothing -> Nothing
+        Just as -> Just (noLoc P.kwAs <+> ppMorpheme as)
 
 instance PrettyPrint OperatorSyntaxDef where
   ppCode OperatorSyntaxDef {..} = do

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

@@ -219,21 +219,36 @@ checkImport ::
   (Members '[Error ScoperError, State Scope, Reader ScopeParameters, State ScoperState, InfoTableBuilder, NameIdGen] r) =>
   Import 'Parsed ->
   Sem r (Import 'Scoped)
-checkImport import_@(Import kw path) = do
+checkImport import_@(Import kw path qual) = do
   checkCycle
   cache <- gets (^. scoperModulesCache . cachedModules)
   moduleRef <- maybe (readScopeModule import_) return (cache ^. at path)
-  let checked = moduleRef ^. moduleRefModule
+  let checked :: Module 'Scoped 'ModuleTop = moduleRef ^. moduleRefModule
       sname :: S.TopModulePath = checked ^. modulePath
       sname' :: S.Name = set S.nameConcrete (topModulePathToName path) sname
       moduleId = sname ^. S.nameId
       cmoduleRef :: ModuleRef'' 'S.Concrete 'ModuleTop = set moduleRefName sname' moduleRef
-  modify (over scopeTopModules (HashMap.insert path moduleRef))
-  registerName (set S.nameConcrete path sname)
+      importName :: S.TopModulePath = set S.nameConcrete path sname
+      synonymName :: Maybe S.TopModulePath = do
+        synonym <- qual
+        return (set S.nameConcrete synonym sname)
+      qual' :: Maybe S.TopModulePath
+      qual' = do
+        asName <- qual
+        return (set S.nameConcrete asName sname')
+  addModuleToScope moduleRef
+  registerName importName
+  whenJust synonymName registerName
   let moduleRef' = mkModuleRef' moduleRef
   modify (over scoperModules (HashMap.insert moduleId moduleRef'))
-  return (Import kw cmoduleRef)
+  return (Import kw cmoduleRef qual')
   where
+    addModuleToScope :: ModuleRef'' 'S.NotConcrete 'ModuleTop -> Sem r ()
+    addModuleToScope moduleRef = do
+      let mpath :: TopModulePath = fromMaybe path qual
+          uid :: S.NameId = moduleRef ^. moduleRefName . S.nameId
+          singTbl = HashMap.singleton uid moduleRef
+      modify (over (scopeTopModules . at mpath) (Just . maybe singTbl (HashMap.insert uid moduleRef)))
     checkCycle :: Sem r ()
     checkCycle = do
       topp <- asks (^. scopeTopParents)
@@ -260,7 +275,7 @@ lookupSymbolAux ::
 lookupSymbolAux modules final = do
   local' <- hereOrInLocalModule
   import' <- importedTopModule
-  return $ local' ++ maybeToList import'
+  return (local' ++ import')
   where
     hereOrInLocalModule :: Sem r [SymbolEntry] =
       case modules of
@@ -276,9 +291,10 @@ lookupSymbolAux modules final = do
             . fmap (mapMaybe getModuleRef . toList . (^. symbolInfo))
             . HashMap.lookup p
             <$> gets (^. scopeSymbols)
-    importedTopModule :: Sem r (Maybe SymbolEntry)
+    importedTopModule :: Sem r [SymbolEntry]
     importedTopModule = do
-      fmap (EntryModule . mkModuleRef') . HashMap.lookup path <$> gets (^. scopeTopModules)
+      tbl <- gets (^. scopeTopModules)
+      return (tbl ^.. at path . _Just . each . to (EntryModule . mkModuleRef'))
       where
         path = TopModulePath modules final
 
@@ -314,7 +330,7 @@ lookupQualifiedSymbol (path, sym) = do
     -- Looks for a top level modules
     there :: Sem r [SymbolEntry]
     there = do
-      concatMapM (fmap maybeToList . uncurry lookInTopModule) allTopPaths
+      concatMapM (uncurry lookInTopModule) allTopPaths
       where
         allTopPaths :: [(TopModulePath, [Symbol])]
         allTopPaths = map (first nonEmptyToTopPath) raw
@@ -326,9 +342,15 @@ lookupQualifiedSymbol (path, sym) = do
               ]
             nonEmptyToTopPath :: NonEmpty Symbol -> TopModulePath
             nonEmptyToTopPath l = TopModulePath (NonEmpty.init l) (NonEmpty.last l)
-        lookInTopModule :: TopModulePath -> [Symbol] -> Sem r (Maybe SymbolEntry)
-        lookInTopModule topPath remaining =
-          ((fmap (^. moduleExportInfo) . HashMap.lookup topPath) >=> lookInExport sym remaining) <$> gets (^. scopeTopModules)
+        lookInTopModule :: TopModulePath -> [Symbol] -> Sem r [SymbolEntry]
+        lookInTopModule topPath remaining = do
+          tbl <- gets (^. scopeTopModules)
+          return $
+            catMaybes
+              [ lookInExport sym remaining (ref ^. moduleExportInfo)
+                | Just t <- [tbl ^. at topPath],
+                  ref <- toList t
+              ]
 
 checkQualifiedExpr ::
   (Members '[Error ScoperError, State Scope, State ScoperState, InfoTableBuilder] r) =>
@@ -524,7 +546,6 @@ topBindings :: Sem (Reader BindingStrategy ': r) a -> Sem r a
 topBindings = runReader BindingTop
 
 localBindings :: Sem (Reader BindingStrategy ': r) a -> Sem r a
--- localBindings = local (const BindingLocal)
 localBindings = runReader BindingLocal
 
 checkTopModule ::
@@ -706,7 +727,7 @@ checkOpenImportModule ::
 checkOpenImportModule op
   | Just k <- op ^. openModuleImportKw =
       let import_ :: Import 'Parsed
-          import_ = Import k (moduleNameToTopModulePath (op ^. openModuleName))
+          import_ = Import k (moduleNameToTopModulePath (op ^. openModuleName)) Nothing
        in do
             void (checkImport import_)
             scopedOpen <- checkOpenModule (set openModuleImportKw Nothing op)

src/Juvix/Compiler/Concrete/Translation/FromSource.hs

@@ -289,12 +289,16 @@ operatorSyntaxDef = do
 -- Import statement
 --------------------------------------------------------------------------------
 
-import_ :: Members '[Files, PathResolver, InfoTableBuilder, JudocStash, NameIdGen, Error ParserError] r => ParsecS r (Import 'Parsed)
+import_ :: forall r. Members '[Files, PathResolver, InfoTableBuilder, JudocStash, NameIdGen, Error ParserError] r => ParsecS r (Import 'Parsed)
 import_ = do
   _importKw <- kw kwImport
   _importModule <- topModulePath
   P.lift (importedModule _importModule)
+  _importAsName <- optional pasName
   return Import {..}
+  where
+    pasName :: ParsecS r TopModulePath
+    pasName = void (kw kwAs) >> topModulePath
 
 withPath' ::
   forall r a.

src/Juvix/Data/CodeAnn.hs

@@ -152,6 +152,9 @@ kwUsing = keyword Str.using
 kwHiding :: Doc Ann
 kwHiding = keyword Str.hiding
 
+kwAs :: Doc Ann
+kwAs = keyword Str.as
+
 kwImport :: Doc Ann
 kwImport = keyword Str.import_
 

src/Juvix/Data/Keyword/All.hs

@@ -7,6 +7,9 @@ where
 import Juvix.Data.Keyword
 import Juvix.Extra.Strings qualified as Str
 
+kwAs :: Keyword
+kwAs = asciiKw Str.as
+
 kwBuiltin :: Keyword
 kwBuiltin = asciiKw Str.builtin
 

src/Juvix/Extra/Strings.hs

@@ -209,6 +209,9 @@ intLt = "int-lt"
 intPrint :: (IsString s) => s
 intPrint = "int-print"
 
+as :: IsString s => s
+as = "as"
+
 builtin :: IsString s => s
 builtin = "builtin"
 

test/Scope/Positive.hs

@@ -217,6 +217,10 @@ tests =
       "Case expressions"
       $(mkRelDir "Internal")
       $(mkRelFile "Case.juvix"),
+    PosTest
+      "Qualified imports"
+      $(mkRelDir "QualifiedImports")
+      $(mkRelFile "Main.juvix"),
     PosTest
       "Short syntax for multiple parameters"
       $(mkRelDir ".")

tests/positive/QualifiedImports/Main.juvix

@@ -0,0 +1,21 @@
+module Main;
+
+import Stdlib.Data.Nat as Prelude;
+import Stdlib.Prelude as Longer.For.No.Reason;
+
+open Prelude;
+
+axiom a : Nat;
+
+axiom b : Longer.For.No.Reason.Nat;
+
+main : Prelude.Nat;
+main := 123;
+
+-- Merging imports
+import Stdlib.Data.Nat as X;
+import Stdlib.Data.Int as X;
+
+axiom c : X.Nat;
+
+axiom d : X.Int;

tests/positive/QualifiedImports/juvix.yaml

@@ -0,0 +1,4 @@
+dependencies:
+- .juvix-build/stdlib/
+name: qualifiedimports
+version: 0.0.0