Properly handle confluent imports (#2915)

- Fixes #2914

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

@@ -711,9 +711,9 @@ lookupQualifiedSymbol ::
   forall r.
   (Members '[State Scope, State ScoperState] r) =>
   ([Symbol], Symbol) ->
-  Sem r ([PreSymbolEntry], [ModuleSymbolEntry], [FixitySymbolEntry])
+  Sem r (HashSet PreSymbolEntry, HashSet ModuleSymbolEntry, HashSet FixitySymbolEntry)
 lookupQualifiedSymbol sms = do
-  (es, (ms, fs)) <- runOutputList . runOutputList . execOutputList $ go sms
+  (es, (ms, fs)) <- runOutputHashSet . runOutputHashSet . execOutputHashSet $ go sms
   return (es, ms, fs)
   where
     go ::
@@ -758,7 +758,10 @@ lookupQualifiedSymbol sms = do
 normalizePreSymbolEntry :: (Members '[State ScoperState] r) => PreSymbolEntry -> Sem r SymbolEntry
 normalizePreSymbolEntry = \case
   PreSymbolFinal a -> return a
-  PreSymbolAlias a -> gets (^?! scoperAlias . at (a ^. aliasName . S.nameId) . _Just) >>= normalizePreSymbolEntry
+  PreSymbolAlias a -> gets (^. scoperAlias . at (a ^. aliasName . S.nameId)) >>= normalizePreSymbolEntry . fromMaybe err
+    where
+      err :: forall a. a
+      err = impossibleError ("The alias " <> ppTrace (a ^. aliasName) <> " was not found in the ScoperState ")
 
 checkQualifiedName ::
   (Members '[Error ScoperError, State Scope, State ScoperState, InfoTableBuilder, Reader InfoTable] r) =>
@@ -766,10 +769,10 @@ checkQualifiedName ::
   Sem r PreSymbolEntry
 checkQualifiedName q@(QualifiedName (SymbolPath p) sym) = do
   es <- fst3 <$> lookupQualifiedSymbol (toList p, sym)
-  case es of
+  case toList es of
     [] -> notInScope
     [e] -> return e
-    _ -> throw (ErrAmbiguousSym (AmbiguousSym q' es))
+    _ -> throw (ErrAmbiguousSym (AmbiguousSym q' (toList es)))
   where
     q' = NameQualified q
     notInScope = throw (ErrQualSymNotInScope (QualSymNotInScope q))
@@ -1820,7 +1823,7 @@ lookupModuleSymbol ::
   Sem r ScopedModule
 lookupModuleSymbol n = do
   es <- snd3 <$> lookupQualifiedSymbol (path, sym)
-  case nonEmpty (resolveShadowing es) of
+  case nonEmpty (resolveShadowing (toList es)) of
     Nothing -> notInScope
     Just (x :| []) -> getModule x n
     Just more -> throw (ErrAmbiguousModuleSym (AmbiguousModuleSym n more))
@@ -2384,7 +2387,7 @@ checkUnqualifiedName s = do
   scope <- get
   -- Lookup at the global scope
   entries <- fst3 <$> lookupQualifiedSymbol ([], s)
-  case resolveShadowing entries of
+  case resolveShadowing (toList entries) of
     [] -> throw (ErrSymNotInScope (NotInScope s scope))
     [x] -> return x
     es -> throw (ErrAmbiguousSym (AmbiguousSym n es))
@@ -2399,7 +2402,7 @@ checkFixitySymbol s = do
   scope <- get
   -- Lookup at the global scope
   entries <- thd3 <$> lookupQualifiedSymbol ([], s)
-  case resolveShadowing entries of
+  case resolveShadowing (toList entries) of
     [] -> throw (ErrSymNotInScope (NotInScope s scope))
     [x] -> do
       let res = entryToSymbol x s
@@ -2473,13 +2476,14 @@ lookupNameOfKind ::
   Name ->
   Sem r (Maybe ScopedIden)
 lookupNameOfKind nameKind n = do
-  entries <- lookupQualifiedSymbol (path, sym) >>= mapMaybeM filterEntry . fst3
+  entries <- lookupQualifiedSymbol (path, sym) >>= mapMaybeM filterEntry . toList . fst3
   case entries of
     [] -> return Nothing
     [(_, s)] -> return (Just s) -- There is one constructor with such a name
     es -> throw (ErrAmbiguousSym (AmbiguousSym n (map fst es)))
   where
     (path, sym) = splitName n
+
     filterEntry :: PreSymbolEntry -> Sem r (Maybe (PreSymbolEntry, ScopedIden))
     filterEntry e = do
       e' <- entryToScopedIden n e

src/Juvix/Compiler/Store/Scoped/Data/SymbolEntry.hs

@@ -14,6 +14,8 @@ instance Serialize Alias
 
 instance NFData Alias
 
+instance Hashable Alias
+
 -- | Either an alias or a symbol entry.
 data PreSymbolEntry
   = PreSymbolAlias Alias
@@ -24,6 +26,8 @@ instance Serialize PreSymbolEntry
 
 instance NFData PreSymbolEntry
 
+instance Hashable PreSymbolEntry
+
 -- | A symbol which is not an alias.
 newtype SymbolEntry = SymbolEntry
   { _symbolEntry :: S.Name
@@ -45,6 +49,8 @@ instance Serialize ModuleSymbolEntry
 
 instance NFData ModuleSymbolEntry
 
+instance Hashable ModuleSymbolEntry
+
 newtype FixitySymbolEntry = FixitySymbolEntry
   { _fixityEntry :: S.Name
   }
@@ -54,6 +60,8 @@ instance Serialize FixitySymbolEntry
 
 instance NFData FixitySymbolEntry
 
+instance Hashable FixitySymbolEntry
+
 makeLenses ''Alias
 makeLenses ''SymbolEntry
 makeLenses ''ModuleSymbolEntry

src/Juvix/Prelude/Base/Foundation.hs

@@ -477,6 +477,9 @@ undefined = Err.error "undefined"
 impossible :: (HasCallStack) => a
 impossible = Err.error "impossible"
 
+impossibleError :: (HasCallStack) => Text -> a
+impossibleError msg = Err.error ("impossible: " <> unpack msg)
+
 --------------------------------------------------------------------------------
 
 infixl 7 <+?>

src/Juvix/Prelude/Effects/Accum.hs

@@ -1,6 +1,7 @@
 module Juvix.Prelude.Effects.Accum
   ( Accum,
     runAccumList,
+    runAccumListReverse,
     execAccumList,
     ignoreAccum,
     accum,
@@ -21,10 +22,13 @@ newtype instance StaticRep (Accum o) = Accum
 accum :: (Member (Accum o) r) => o -> Sem r ()
 accum o = overStaticRep (\(Accum l) -> Accum (o : l))
 
-runAccumList :: Sem (Accum o ': r) a -> Sem r ([o], a)
-runAccumList m = do
+runAccumListReverse :: Sem (Accum o ': r) a -> Sem r ([o], a)
+runAccumListReverse m = do
   (a, Accum s) <- runStaticRep (Accum mempty) m
-  return (reverse s, a)
+  return (s, a)
+
+runAccumList :: Sem (Accum o ': r) a -> Sem r ([o], a)
+runAccumList m = first reverse <$> runAccumListReverse m
 
 execAccumList :: Sem (Accum o ': r) a -> Sem r [o]
 execAccumList = fmap fst . runAccumList

src/Juvix/Prelude/Effects/Output.hs

@@ -27,10 +27,22 @@ runOutputSem handle =
   interpret $ \case
     Output x -> handle x
 
+runOutputHashSet :: (Hashable o) => Sem (Output o ': r) a -> Sem r (HashSet o, a)
+runOutputHashSet =
+  fmap (first hashSet)
+    . reinterpret
+      runAccumListReverse
+      ( \case
+          Output x -> accum x
+      )
+
 runOutputList :: Sem (Output o ': r) a -> Sem r ([o], a)
 runOutputList = reinterpret runAccumList $ \case
   Output x -> accum x
 
+execOutputHashSet :: (Hashable o) => Sem (Output o ': r) a -> Sem r (HashSet o)
+execOutputHashSet = fmap fst . runOutputHashSet
+
 execOutputList :: Sem (Output o ': r) a -> Sem r [o]
 execOutputList = fmap fst . runOutputList
 

test/Scope/Positive.hs

@@ -250,6 +250,10 @@ tests =
       "Named argument puns"
       $(mkRelDir ".")
       $(mkRelFile "Puns.juvix"),
+    posTest
+      "Confluent imports"
+      $(mkRelDir "ConfluentScoping")
+      $(mkRelFile "Main.juvix"),
     posTest
       "Record field iterator"
       $(mkRelDir ".")

tests/positive/ConfluentScoping/A.juvix

@@ -0,0 +1,3 @@
+module A;
+
+import B public;

tests/positive/ConfluentScoping/B.juvix

@@ -0,0 +1,3 @@
+module B;
+
+axiom Axiom : Type;

tests/positive/ConfluentScoping/Main.juvix

@@ -0,0 +1,6 @@
+module Main;
+
+import A open;
+import B;
+
+axiom X : B.Axiom;

tests/positive/ConfluentScoping/Package.juvix

@@ -0,0 +1,8 @@
+module Package;
+
+import PackageDescription.V2 open;
+
+package : Package :=
+  defaultPackage@?{
+    name := "confluentscoping"
+  };