1
1
mirror of https://github.com/anoma/juvix.git synced 2024-12-24 16:12:14 +03:00

Fix compiler error on import cycles (#3171)

- Fixes #3161 

The strongly connected components given in [this
function](https://hackage.haskell.org/package/containers-0.7/docs/Data-Graph.html#v:stronglyConnComp)
are not guaranteed to give a cycle in the order they are given. I've
fixed that
This commit is contained in:
Jan Mas Rovira 2024-11-15 09:41:02 +01:00 committed by GitHub
parent 49c14be71e
commit 1d7bf1f25b
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
18 changed files with 147 additions and 44 deletions

View File

@ -10,4 +10,4 @@ import Commands.Dev.Anoma.Options
runCommand :: (Members AppEffects r) => AnomaCommand -> Sem r ()
runCommand = \case
Node opts -> Node.runCommand opts
AnomaCommandNode opts -> Node.runCommand opts

View File

@ -4,7 +4,7 @@ import Commands.Dev.Anoma.Node.Options
import CommonOptions
newtype AnomaCommand
= Node NodeOptions
= AnomaCommandNode NodeOptions
deriving stock (Data)
parseAnomaCommand :: Parser AnomaCommand
@ -20,5 +20,5 @@ parseAnomaCommand =
runInfo :: ParserInfo AnomaCommand
runInfo =
info
(Node <$> parseNodeOptions)
(AnomaCommandNode <$> parseNodeOptions)
(progDesc "Run an Anoma node and client.")

View File

@ -47,10 +47,11 @@ extra-source-files:
- config/configure.sh
dependencies:
- aeson-better-errors == 0.9.*
- aeson == 2.2.*
- aeson-better-errors == 0.9.*
- aeson-pretty == 0.8.*
- ansi-terminal == 1.1.*
- array == 0.5.*
- base == 4.19.*
- base16-bytestring == 1.0.*
- base64-bytestring == 1.2.*

View File

@ -18,7 +18,7 @@ import Juvix.Compiler.Concrete.Language
import Juvix.Compiler.Concrete.Print
import Juvix.Compiler.Pipeline.EntryPoint
import Juvix.Extra.Assets
import Juvix.Prelude
import Juvix.Prelude hiding (Tree)
import Juvix.Prelude.Pretty
import Text.Blaze.Html.Renderer.Utf8 qualified as Html
import Text.Blaze.Html5 as Html hiding (map)

View File

@ -119,8 +119,7 @@ instance ToGenericError InfixErrorP where
<> "Perhaps you forgot parentheses around a pattern?"
newtype ImportCycleNew = ImportCycleNew
{ -- | If we have [a, b, c] it means that a import b imports c imports a.
_importCycleImportsNew :: NonEmpty ImportScan
{ _importCycleImportsNew :: GraphCycle ImportScan
}
deriving stock (Show)
@ -136,7 +135,8 @@ instance ToGenericError ImportCycleNew where
}
where
opts' = fromGenericOptions opts
h = head _importCycleImportsNew
cycl = _importCycleImportsNew ^. graphCycleVertices
h = head cycl
i = getLoc h
msg =
"There is an import cycle:"
@ -147,7 +147,7 @@ instance ToGenericError ImportCycleNew where
. map pp
. toList
. tie
$ _importCycleImportsNew
$ cycl
)
pp :: ImportScan -> Doc Ann

View File

@ -1,6 +1,7 @@
module Juvix.Compiler.Pipeline.Loader.PathResolver.ImportTree where
import Data.HashMap.Strict qualified as HashMap
import Data.Text qualified as Text
import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error
import Juvix.Compiler.Concrete.Translation.ImportScanner
import Juvix.Compiler.Pipeline.Loader.PathResolver.Base
@ -114,38 +115,42 @@ withImportTree entryModule x = do
checkImportTreeCycles :: forall r. (Members '[Error ScoperError] r) => ImportTree -> Sem r ()
checkImportTreeCycles tree = do
let sccs =
stronglyConnComp
[ (node, node, toList v) | (node, v) <- HashMap.toList (tree ^. importTree)
]
whenJust (firstJust getCycle sccs) $ \(cyc :: NonEmpty ImportNode) ->
let graph :: GraphInfo ImportNode ImportNode =
mkGraphInfo [(node, node, toList v) | (node, v) <- HashMap.toList (tree ^. importTree)]
whenJust (graphCycle graph) $ \(cyc :: GraphCycle ImportNode) ->
throw
. ErrImportCycleNew
. ImportCycleNew
$ getEdges cyc
. getEdges
$ cyc
where
getEdges :: NonEmpty ImportNode -> NonEmpty ImportScan
getEdges = fmap (uncurry getEdge) . zipWithNextLoop
getEdge :: ImportNode -> ImportNode -> ImportScan
getEdge fromN toN = fromMaybe unexpected $ do
edges <- tree ^. importTreeEdges . at fromN
let rel :: Path Rel File = removeExtensions (toN ^. importNodeFile)
cond :: ImportScan -> Bool
cond = (== rel) . importScanToRelPath
find cond edges
getEdges :: GraphCycle ImportNode -> GraphCycle ImportScan
getEdges cycl =
over
graphCycleVertices
( fmap (uncurry getEdge)
. zipWithNextLoop
)
cycl
where
unexpected =
error $
"Impossible: Could not find edge between\n"
<> prettyText fromN
<> "\nand\n"
<> prettyText toN
<> "\n"
<> "Available Edges:\n"
<> prettyText (toList (tree ^. importTreeEdges . at fromN . _Just))
getCycle :: SCC ImportNode -> Maybe (NonEmpty ImportNode)
getCycle = \case
AcyclicSCC {} -> Nothing
CyclicSCC l -> Just (nonEmpty' l)
getEdge :: ImportNode -> ImportNode -> ImportScan
getEdge fromN toN = fromMaybe unexpected $ do
edges <- tree ^. importTreeEdges . at fromN
let rel :: Path Rel File = removeExtensions (toN ^. importNodeFile)
cond :: ImportScan -> Bool
cond = (== rel) . importScanToRelPath
find cond edges
where
unexpected =
impossibleError $
"Could not find edge between\n"
<> prettyText fromN
<> "\nand\n"
<> prettyText toN
<> "\n"
<> "Available Edges from "
<> prettyText fromN
<> ":\n"
<> prettyText (toList (tree ^. importTreeEdges . at fromN . _Just))
<> "\n\nCycle found:\n"
<> Text.unlines (prettyText <$> toList (cycl ^. graphCycleVertices))

View File

@ -79,8 +79,6 @@ runImportTreeBuilder = reinterpret (runState emptyImportTree) $ \case
modify (over fimportTree (insertHelper fromNode toNode))
modify (over fimportTreeReverse (insertHelper toNode fromNode))
modify (over fimportTreeEdges (insertHelper fromNode importScan))
where
where
insertHelper :: (Hashable k, Hashable v) => k -> v -> HashMap k (HashSet v) -> HashMap k (HashSet v)
insertHelper k v = over (at k) (Just . maybe (HashSet.singleton v) (HashSet.insert v))

View File

@ -10,7 +10,7 @@ data ImportNode = ImportNode
deriving stock (Eq, Ord, Generic, Show)
instance Pretty ImportNode where
pretty ImportNode {..} = pretty _importNodePackageRoot <+> ":" <+> show _importNodeFile
pretty ImportNode {..} = pretty _importNodePackageRoot <+> ":" <+> pretty _importNodeFile
instance Hashable ImportNode

View File

@ -3,6 +3,7 @@
module Juvix.Prelude.Base.Foundation
( module Juvix.Prelude.Base.Foundation,
module Control.Applicative,
module Data.Tree,
module Data.Graph,
module Text.Show.Unicode,
module Data.Map.Strict,
@ -123,6 +124,7 @@ import Control.Monad.Extra qualified as Monad
import Control.Monad.Fix
import Control.Monad.IO.Class (MonadIO (..))
import Control.Monad.Zip
import Data.Array qualified as Array
import Data.Bifunctor hiding (first, second)
import Data.Bitraversable
import Data.Bool
@ -136,7 +138,8 @@ import Data.Foldable hiding (foldr1, minimum, minimumBy)
import Data.Function
import Data.Functor
import Data.Functor.Identity
import Data.Graph (Graph, SCC (..), Vertex, stronglyConnComp)
import Data.Graph (Graph, SCC (..), Vertex, scc, stronglyConnComp)
import Data.Graph qualified as Graph
import Data.HashMap.Lazy qualified as LazyHashMap
import Data.HashMap.Strict (HashMap)
import Data.HashMap.Strict qualified as HashMap
@ -188,6 +191,7 @@ import Data.Text.IO.Utf8 hiding (getContents, getLine, hGetLine, hPutStr, hPutSt
import Data.Text.IO.Utf8 qualified as Utf8
import Data.Text.Lazy.Builder qualified as LazyText
import Data.Traversable
import Data.Tree hiding (levels)
import Data.Tuple.Extra hiding (both)
import Data.Type.Equality (type (~))
import Data.Typeable hiding (TyCon)
@ -832,3 +836,55 @@ unicodeSubscript = pack . map toSubscript . show
'8' -> '₈'
'9' -> '₉'
_ -> impossible
-- | A list of vertices [v1, .., vn], s.t. ∀i, ⟨vi, v(i+1 `mod` n)⟩ ∈ Edges
newtype GraphCycle a = GraphCycle
{ _graphCycleVertices :: NonEmpty a
}
deriving stock (Show)
makeLenses ''GraphCycle
data GraphInfo node key = GraphInfo
{ _graphInfoGraph :: Graph,
_graphInfoNodeFromVertex :: Vertex -> (node, key, [key]),
_graphInfoKeyToVertex :: key -> Maybe Vertex
}
makeLenses ''GraphInfo
mkGraphInfo :: (Ord key) => [(node, key, [key])] -> GraphInfo node key
mkGraphInfo e =
let (_graphInfoGraph, _graphInfoNodeFromVertex, _graphInfoKeyToVertex) = Graph.graphFromEdges e
in GraphInfo {..}
graphCycle :: forall node key. GraphInfo node key -> Maybe (GraphCycle node)
graphCycle gi =
case mapM_ findCycle sccs of
Right {} -> Nothing
Left cycl ->
Just
. over graphCycleVertices (fmap getNode)
. GraphCycle
. NonEmpty.reverse
$ cycl
where
sccs :: [Tree Vertex] = scc g
g :: Graph = gi ^. graphInfoGraph
getNode :: Vertex -> node
getNode v = fst3 ((gi ^. graphInfoNodeFromVertex) v)
isEdge :: Vertex -> Vertex -> Bool
isEdge v u = u `elem` (g Array.! v)
findCycle :: Tree Vertex -> Either (NonEmpty Vertex) ()
findCycle (Node root ch) = goChildren (pure root) ch
where
go :: NonEmpty Vertex -> Tree Vertex -> Either (NonEmpty Vertex) ()
go path (Node n ns)
| isEdge n root = Left (NonEmpty.cons n path)
| otherwise = goChildren (NonEmpty.cons n path) ns
goChildren :: NonEmpty Vertex -> [Tree Vertex] -> Either (NonEmpty Vertex) ()
goChildren path = mapM_ (go path)

View File

@ -293,5 +293,10 @@ scoperErrorTests =
"Invalid default"
$(mkRelDir ".")
$(mkRelFile "InvalidDefault.juvix")
$ wantsError ErrWrongDefaultValue
$ wantsError ErrWrongDefaultValue,
negTest
"Import cycles (issue3161)"
$(mkRelDir "issue3161")
$(mkRelFile "Stdlib/Trait/Partial.juvix")
$ wantsError ErrImportCycleNew
]

View File

@ -0,0 +1,10 @@
module Package;
import PackageDescription.V2 open;
package : Package :=
defaultPackage@?{
name := "stdlib";
version := mkVersion 0 0 1;
dependencies := []
};

View File

@ -0,0 +1,3 @@
module Stdlib.Data.Fixity;
import Juvix.Builtin.V1.Fixity open public;

View File

@ -0,0 +1,6 @@
module Stdlib.Data.List.Base;
import Juvix.Builtin.V1.List open public;
import Stdlib.Data.Fixity open;
import Stdlib.Trait.Ord open;
import Stdlib.Trait.Partial open;

View File

@ -0,0 +1,5 @@
module Stdlib.Data.String.Base;
import Juvix.Builtin.V1.String open public;
import Stdlib.Data.List.Base open;
import Stdlib.Data.Fixity open;

View File

@ -0,0 +1,4 @@
module Stdlib.Data.String.Ord;
import Stdlib.Data.Fixity open;
import Stdlib.Data.String.Base open;

View File

@ -0,0 +1,3 @@
module Stdlib.Debug.Fail;
import Stdlib.Data.String.Base open;

View File

@ -0,0 +1,3 @@
module Stdlib.Trait.Ord;
import Stdlib.Data.Fixity open;

View File

@ -0,0 +1,4 @@
module Stdlib.Trait.Partial;
import Stdlib.Data.String.Base open;
import Stdlib.Debug.Fail as Debug;