diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs index ad8f632d1a..8405927e1f 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs +++ b/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 diff --git a/src/Juvix/Compiler/Store/Scoped/Data/SymbolEntry.hs b/src/Juvix/Compiler/Store/Scoped/Data/SymbolEntry.hs index 73aa0f0ad7..de1435bd21 100644 --- a/src/Juvix/Compiler/Store/Scoped/Data/SymbolEntry.hs +++ b/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 diff --git a/src/Juvix/Prelude/Base/Foundation.hs b/src/Juvix/Prelude/Base/Foundation.hs index 638bcaa09d..e00a7bac36 100644 --- a/src/Juvix/Prelude/Base/Foundation.hs +++ b/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 <+?> diff --git a/src/Juvix/Prelude/Effects/Accum.hs b/src/Juvix/Prelude/Effects/Accum.hs index 7ceda3aca9..ff23c64611 100644 --- a/src/Juvix/Prelude/Effects/Accum.hs +++ b/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 diff --git a/src/Juvix/Prelude/Effects/Output.hs b/src/Juvix/Prelude/Effects/Output.hs index eb0081f87b..12ffcca875 100644 --- a/src/Juvix/Prelude/Effects/Output.hs +++ b/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 diff --git a/test/Scope/Positive.hs b/test/Scope/Positive.hs index 6ddad80572..e50d7fead0 100644 --- a/test/Scope/Positive.hs +++ b/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 ".") diff --git a/tests/positive/ConfluentScoping/A.juvix b/tests/positive/ConfluentScoping/A.juvix new file mode 100644 index 0000000000..570f1e06eb --- /dev/null +++ b/tests/positive/ConfluentScoping/A.juvix @@ -0,0 +1,3 @@ +module A; + +import B public; diff --git a/tests/positive/ConfluentScoping/B.juvix b/tests/positive/ConfluentScoping/B.juvix new file mode 100644 index 0000000000..9f81dffff0 --- /dev/null +++ b/tests/positive/ConfluentScoping/B.juvix @@ -0,0 +1,3 @@ +module B; + +axiom Axiom : Type; diff --git a/tests/positive/ConfluentScoping/Main.juvix b/tests/positive/ConfluentScoping/Main.juvix new file mode 100644 index 0000000000..55fe60a9e5 --- /dev/null +++ b/tests/positive/ConfluentScoping/Main.juvix @@ -0,0 +1,6 @@ +module Main; + +import A open; +import B; + +axiom X : B.Axiom; diff --git a/tests/positive/ConfluentScoping/Package.juvix b/tests/positive/ConfluentScoping/Package.juvix new file mode 100644 index 0000000000..2bf8b10d1e --- /dev/null +++ b/tests/positive/ConfluentScoping/Package.juvix @@ -0,0 +1,8 @@ +module Package; + +import PackageDescription.V2 open; + +package : Package := + defaultPackage@?{ + name := "confluentscoping" + };