From 3be1946324012087513cf4fa0841af336b14ea82 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Sun, 1 Dec 2024 14:59:22 +0100 Subject: [PATCH 01/25] hash global package --- src/Juvix/Compiler/Core/Data/Module.hs | 12 +++-- src/Juvix/Compiler/Core/Pretty/Base.hs | 6 +++ src/Juvix/Compiler/Pipeline.hs | 2 + src/Juvix/Compiler/Pipeline/Driver.hs | 6 +++ src/Juvix/Compiler/Pipeline/DriverParallel.hs | 1 + .../Compiler/Pipeline/Loader/PathResolver.hs | 19 ++++++++ .../Loader/PathResolver/GlobalVersions.hs | 11 +++++ .../Loader/PathResolver/PackageInfo.hs | 44 ++++++++++++----- src/Juvix/Compiler/Pipeline/Repl.hs | 5 +- src/Juvix/Compiler/Pipeline/Run.hs | 3 ++ src/Juvix/Data/SHA256.hs | 47 +++++++++++++++++-- src/Juvix/Prelude/Base/Foundation.hs | 7 +++ src/Juvix/Prelude/Effects/Base.hs | 8 ++++ src/Parallel/ProgressLog.hs | 12 +++-- 14 files changed, 155 insertions(+), 28 deletions(-) create mode 100644 src/Juvix/Compiler/Pipeline/Loader/PathResolver/GlobalVersions.hs diff --git a/src/Juvix/Compiler/Core/Data/Module.hs b/src/Juvix/Compiler/Core/Data/Module.hs index 6c3baee651..fead44a112 100644 --- a/src/Juvix/Compiler/Core/Data/Module.hs +++ b/src/Juvix/Compiler/Core/Data/Module.hs @@ -6,6 +6,7 @@ where import Juvix.Compiler.Core.Data.InfoTable import Juvix.Compiler.Core.Language +import Juvix.Compiler.Core.Pretty data Module = Module { _moduleId :: ModuleId, @@ -64,17 +65,20 @@ lookupSpecialisationInfo Module {..} sym = lookupTabSpecialisationInfo' _moduleInfoTable sym <|> lookupTabSpecialisationInfo' _moduleImportsTable sym +impossibleSymbolNotFound :: Symbol -> a +impossibleSymbolNotFound sym = impossibleError ("Could not find symbol " <> ppTrace sym) + lookupInductiveInfo :: Module -> Symbol -> InductiveInfo -lookupInductiveInfo m sym = fromJust $ lookupInductiveInfo' m sym +lookupInductiveInfo m sym = fromMaybe (impossibleSymbolNotFound sym) (lookupInductiveInfo' m sym) lookupConstructorInfo :: Module -> Tag -> ConstructorInfo -lookupConstructorInfo m tag = fromJust $ lookupConstructorInfo' m tag +lookupConstructorInfo m tag = fromJust (lookupConstructorInfo' m tag) lookupIdentifierInfo :: Module -> Symbol -> IdentifierInfo -lookupIdentifierInfo m sym = fromJust $ lookupIdentifierInfo' m sym +lookupIdentifierInfo m sym = fromMaybe (impossibleSymbolNotFound sym) (lookupIdentifierInfo' m sym) lookupIdentifierNode :: Module -> Symbol -> Node -lookupIdentifierNode m sym = fromJust $ lookupIdentifierNode' m sym +lookupIdentifierNode m sym = fromMaybe (impossibleSymbolNotFound sym) (lookupIdentifierNode' m sym) lookupBuiltinInductive :: Module -> BuiltinInductive -> Maybe InductiveInfo lookupBuiltinInductive Module {..} b = diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs index 57af9cb552..ef0c03232b 100644 --- a/src/Juvix/Compiler/Core/Pretty/Base.hs +++ b/src/Juvix/Compiler/Core/Pretty/Base.hs @@ -100,6 +100,12 @@ instance PrettyCode Tag where BuiltinTag tag -> ppCode tag UserTag (TagUser mid tag) -> return $ kwUnnamedConstr <> pretty tag <> "@" <> pretty mid +instance PrettyCode ModuleId where + ppCode = return . pretty + +instance PrettyCode Symbol where + ppCode = return . pretty + instance PrettyCode Primitive where ppCode = \case p@(PrimInteger _) | p == primitiveUInt8 -> return $ annotate (AnnKind KNameInductive) (pretty ("UInt8" :: String)) diff --git a/src/Juvix/Compiler/Pipeline.hs b/src/Juvix/Compiler/Pipeline.hs index c07827748b..955f4f66c0 100644 --- a/src/Juvix/Compiler/Pipeline.hs +++ b/src/Juvix/Compiler/Pipeline.hs @@ -41,6 +41,7 @@ import Juvix.Compiler.Pipeline.Loader.PathResolver.Base import Juvix.Compiler.Pipeline.Loader.PathResolver.Data import Juvix.Compiler.Pipeline.Loader.PathResolver.DependencyResolver import Juvix.Compiler.Pipeline.Loader.PathResolver.Error +import Juvix.Compiler.Pipeline.Loader.PathResolver.GlobalVersions import Juvix.Compiler.Pipeline.ModuleInfoCache import Juvix.Compiler.Pipeline.Options import Juvix.Compiler.Pipeline.Package.Loader.Error @@ -65,6 +66,7 @@ type PipelineLocalEff = Reader ImportTree, Reader ImportScanStrategy, TopModuleNameChecker, + Reader GlobalVersions, PathResolver, Reader DependenciesConfig, DependencyResolver, diff --git a/src/Juvix/Compiler/Pipeline/Driver.hs b/src/Juvix/Compiler/Pipeline/Driver.hs index 3fcb3a508e..5974724edd 100644 --- a/src/Juvix/Compiler/Pipeline/Driver.hs +++ b/src/Juvix/Compiler/Pipeline/Driver.hs @@ -71,6 +71,7 @@ evalModuleInfoCacheSequential :: Reader EntryPoint, Reader ImportTree, Reader PipelineOptions, + Reader GlobalVersions, PathResolver ] r @@ -140,6 +141,7 @@ evalModuleInfoCacheSetup :: Files, Reader ImportTree, Reader PipelineOptions, + Reader GlobalVersions, PathResolver ] r @@ -288,6 +290,7 @@ processRecursiveUpToTyped :: TaggedLock, HighlightBuilder, Error JuvixError, + Reader GlobalVersions, Files, PathResolver, ModuleInfoCache @@ -312,10 +315,13 @@ processRecursiveUpToTyped = do where goImport :: ImportNode -> Sem r InternalTypedResult goImport node = do + pkgInfo <- fromJust . HashMap.lookup (node ^. importNodePackageRoot) <$> getPackageInfos + pid <- packageLikePackageId (pkgInfo ^. packagePackage) entry <- ask let entry' = entry { _entryPointStdin = Nothing, + _entryPointPackageId = pid, _entryPointModulePath = Just (node ^. importNodeAbsFile) } (^. pipelineResult) <$> runReader entry' (processFileUpTo upToInternalTyped) diff --git a/src/Juvix/Compiler/Pipeline/DriverParallel.hs b/src/Juvix/Compiler/Pipeline/DriverParallel.hs index c06aa10930..cc0f4b8eec 100644 --- a/src/Juvix/Compiler/Pipeline/DriverParallel.hs +++ b/src/Juvix/Compiler/Pipeline/DriverParallel.hs @@ -138,6 +138,7 @@ evalModuleInfoCacheParallel :: Reader ImportScanStrategy, Reader NumThreads, Reader PipelineOptions, + Reader GlobalVersions, Logger, Files ] diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs index 8f0b8cb5c3..1d2f8ddab9 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs @@ -10,6 +10,7 @@ module Juvix.Compiler.Pipeline.Loader.PathResolver runPathResolverPipe', evalPathResolverPipe, findPackageJuvixFiles, + runGlobalVersions, ) where @@ -36,6 +37,24 @@ import Juvix.Extra.Paths import Juvix.Extra.Stdlib (ensureStdlib) import Juvix.Prelude +runGlobalVersions :: forall r a. (Members '[PathResolver, Files, TaggedLock, Error JuvixError, EvalFileEff] r) => Sem (Reader GlobalVersions ': r) a -> Sem r a +runGlobalVersions m = do + infos <- toList <$> getPackageInfos + globalVer <- findJustM getGlobalPkgVersion infos + let g = + GlobalVersions + { _globalVersionsStdlib = globalVer + } + runReader g m + where + getGlobalPkgVersion :: PackageInfo -> Sem r (Maybe SemVer) + getGlobalPkgVersion pkginfo = runFail $ do + PackageGlobalStdlib <- pure (pkginfo ^. packagePackage) + meta <- SHA256.digestFiles (packageFiles pkginfo) + pkg <- readGlobalPackage + -- NOTE that we ignore the meta in the version field of the Package.juvix file + return ((pkg ^. packageVersion) {_svMeta = Just meta}) + mkPackage :: forall r. (Members '[Files, Error JuvixError, Reader ResolverEnv, DependencyResolver, EvalFileEff] r) => diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/GlobalVersions.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/GlobalVersions.hs new file mode 100644 index 0000000000..7e52db4c31 --- /dev/null +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/GlobalVersions.hs @@ -0,0 +1,11 @@ +module Juvix.Compiler.Pipeline.Loader.PathResolver.GlobalVersions where + +import Data.Versions +import Juvix.Prelude + +newtype GlobalVersions = GlobalVersions + { -- | This should be filled in iff one of the dependencies is the global standard library + _globalVersionsStdlib :: Maybe SemVer + } + +makeLenses ''GlobalVersions diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs index 3d2a785baa..3d4fc8ab38 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs @@ -1,6 +1,7 @@ module Juvix.Compiler.Pipeline.Loader.PathResolver.PackageInfo ( module Juvix.Compiler.Pipeline.Loader.PathResolver.PackageInfo, module Juvix.Compiler.Concrete.Translation.ImportScanner.Base, + module Juvix.Compiler.Pipeline.Loader.PathResolver.GlobalVersions, ) where @@ -8,6 +9,7 @@ import Data.HashSet qualified as HashSet import Data.Versions import Juvix.Compiler.Concrete.Translation.ImportScanner.Base import Juvix.Compiler.Pipeline.EntryPoint +import Juvix.Compiler.Pipeline.Loader.PathResolver.GlobalVersions import Juvix.Data.CodeAnn import Juvix.Extra.Strings qualified as Str import Juvix.Prelude @@ -31,6 +33,7 @@ data PackageInfo = PackageInfo deriving stock (Show) makeLenses ''PackageInfo +makePrisms ''PackageLike packageFiles :: PackageInfo -> [Path Abs File] packageFiles k = [k ^. packageRoot f | f <- toList (k ^. packageJuvixRelativeFiles)] @@ -43,6 +46,15 @@ packageJuvixFiles = keepJuvixFiles :: HashSet (Path Rel File) -> HashSet (Path Rel File) keepJuvixFiles = HashSet.filter isJuvixOrJuvixMdFile +packageLikePackageId :: (Members '[Reader GlobalVersions] r) => PackageLike -> Sem r PackageId +packageLikePackageId p = do + ver <- packageLikeVersion p + return + PackageId + { _packageIdName = p ^. packageLikeName, + _packageIdVersion = ver + } + packageLikeName :: SimpleGetter PackageLike Text packageLikeName = to $ \case PackageReal r -> r ^. packageName @@ -51,19 +63,27 @@ packageLikeName = to $ \case PackageType -> "package-type" PackageDotJuvix -> "package-dot-juvix" --- | FIXME all PackageLike should have versions -packageLikeVersion :: SimpleGetter PackageLike (Maybe SemVer) -packageLikeVersion = to $ \case - PackageReal pkg -> Just (pkg ^. packageVersion) - PackageGlobalStdlib {} -> Nothing - PackageBase {} -> Nothing - PackageType {} -> Nothing - PackageDotJuvix {} -> Nothing +packageLikeVersion :: (Members '[Reader GlobalVersions] r) => PackageLike -> Sem r SemVer +packageLikeVersion = \case + PackageReal pkg -> return (pkg ^. packageVersion) + PackageGlobalStdlib {} -> fromMaybe err <$> asks (^. globalVersionsStdlib) + PackageBase {} -> return defaultVersion + PackageType {} -> return defaultVersion + PackageDotJuvix {} -> return defaultVersion + where + err :: a + err = impossibleError "Asked the version of the global standard library but wasn't there" -packageLikeNameAndVersion :: SimpleGetter PackageLike (Doc CodeAnn) -packageLikeNameAndVersion = to $ \n -> - annotate AnnImportant (pretty (n ^. packageLikeName)) - <+?> (pretty . prettySemVer <$> n ^. packageLikeVersion) +packageLikeNameAndVersion :: + (Members '[Reader GlobalVersions] r) => + PackageLike -> + Sem r (Doc CodeAnn) +packageLikeNameAndVersion n = do + v <- packageLikeVersion n + return + ( annotate AnnImportant (pretty (n ^. packageLikeName)) + <+> pretty (prettySemVer v) + ) packageLikeDependencies :: SimpleGetter PackageLike [Dependency] packageLikeDependencies = to $ \case diff --git a/src/Juvix/Compiler/Pipeline/Repl.hs b/src/Juvix/Compiler/Pipeline/Repl.hs index 545a5577fb..793761a8d8 100644 --- a/src/Juvix/Compiler/Pipeline/Repl.hs +++ b/src/Juvix/Compiler/Pipeline/Repl.hs @@ -18,9 +18,7 @@ import Juvix.Compiler.Pipeline.Artifacts import Juvix.Compiler.Pipeline.Artifacts.PathResolver import Juvix.Compiler.Pipeline.Driver import Juvix.Compiler.Pipeline.EntryPoint -import Juvix.Compiler.Pipeline.Loader.PathResolver (runDependencyResolver) -import Juvix.Compiler.Pipeline.Loader.PathResolver.Base -import Juvix.Compiler.Pipeline.Loader.PathResolver.Error +import Juvix.Compiler.Pipeline.Loader.PathResolver import Juvix.Compiler.Pipeline.Loader.PathResolver.ImportTree (withImportTree) import Juvix.Compiler.Pipeline.Package.Loader.Error import Juvix.Compiler.Pipeline.Package.Loader.EvalEff.IO @@ -182,6 +180,7 @@ compileReplInputIO fp txt = do . runTopModuleNameChecker . runReader defaultImportScanStrategy . withImportTree (Just fp) + . runGlobalVersions . evalModuleInfoCacheHelper $ do p <- parseReplInput fp txt diff --git a/src/Juvix/Compiler/Pipeline/Run.hs b/src/Juvix/Compiler/Pipeline/Run.hs index aad458a24e..f4df134629 100644 --- a/src/Juvix/Compiler/Pipeline/Run.hs +++ b/src/Juvix/Compiler/Pipeline/Run.hs @@ -126,6 +126,7 @@ runIOEitherPipeline' entry a = do . runDependencyResolver . runReader (opts ^. pipelineDependenciesConfig) . runPathResolverInput + . runGlobalVersions . runTopModuleNameChecker . runReader (opts ^. pipelineImportStrategy) . withImportTree (entry ^. entryPointModulePath) @@ -147,6 +148,7 @@ evalModuleInfoCacheHelper :: Reader ImportScanStrategy, Reader NumThreads, Reader PipelineOptions, + Reader GlobalVersions, Logger, Files ] @@ -234,6 +236,7 @@ runReplPipelineIOEither' lockMode entry = do . runTopModuleNameChecker . runReader defaultImportScanStrategy . withImportTree (entry ^. entryPointModulePath) + . runGlobalVersions . evalModuleInfoCacheHelper $ processFileToStoredCore entry return $ case eith of diff --git a/src/Juvix/Data/SHA256.hs b/src/Juvix/Data/SHA256.hs index 01ac0306f5..fc569e69ab 100644 --- a/src/Juvix/Data/SHA256.hs +++ b/src/Juvix/Data/SHA256.hs @@ -4,13 +4,52 @@ import Crypto.Hash.SHA256 qualified as SHA256 import Data.ByteString.Base16 qualified as Base16 import Juvix.Prelude -digestText :: Text -> Text -digestText = +hashToText :: ByteString -> Text +hashToText = decodeUtf8Lenient . Base16.encode + +digestText :: Text -> Text +digestText = + hashToText . SHA256.hash . encodeUtf8 --- | Create a HEX encoded, SHA256 digest of the contents of a file. +-- | Create a HEX encoded, SHA256 digest of the contents of a file digestFile :: (Member Files r) => Path Abs File -> Sem r Text -digestFile = fmap (decodeUtf8Lenient . Base16.encode . SHA256.hash) . readFileBS' +digestFile = fmap hashToText . digestFileBS + +digestFileBS :: (Member Files r) => Path Abs File -> Sem r ByteString +digestFileBS = fmap SHA256.hash . readFileBS' + +data SHA256Builder :: Effect where + BuilderDigestFiles :: (Foldable l) => l (Path Abs File) -> SHA256Builder m () + +makeSem ''SHA256Builder + +builderDigestFile :: (Members '[SHA256Builder] r) => Path Abs File -> Sem r () +builderDigestFile p = builderDigestFiles [p] + +runSHA256Builder :: (Members '[Files] r) => Sem (SHA256Builder ': r) a -> Sem r (Text, a) +runSHA256Builder m = fmap + ( first + ( hashToText + . SHA256.finalize + ) + ) + $ reinterpret' m (runState SHA256.init) + $ \case + BuilderDigestFiles f -> do + fs <- mapM readFileBS' (toList f) + modify (\ctx -> SHA256.updates ctx (toList fs)) + +ignoreSHA256Builder :: Sem (SHA256Builder ': r) a -> Sem r a +ignoreSHA256Builder = interpret $ \case + BuilderDigestFiles {} -> return () + +execSHA256Builder :: (Members '[Files] r) => Sem (SHA256Builder ': r) a -> Sem r Text +execSHA256Builder = fmap fst . runSHA256Builder + +-- | Create a HEX encoded, SHA256 digest of the contents of some files +digestFiles :: (Members '[Files] r, Foldable l) => l (Path Abs File) -> Sem r Text +digestFiles = execSHA256Builder . digestFiles diff --git a/src/Juvix/Prelude/Base/Foundation.hs b/src/Juvix/Prelude/Base/Foundation.hs index 87908e1e2d..d2115091f2 100644 --- a/src/Juvix/Prelude/Base/Foundation.hs +++ b/src/Juvix/Prelude/Base/Foundation.hs @@ -4,6 +4,7 @@ module Juvix.Prelude.Base.Foundation ( module Juvix.Prelude.Base.Foundation, module Control.Applicative, module Data.Tree, + module Data.Versions, module Data.Graph, module Text.Show.Unicode, module Data.Map.Strict, @@ -196,6 +197,7 @@ import Data.Tree hiding (levels) import Data.Tuple.Extra hiding (both) import Data.Type.Equality (type (~)) import Data.Typeable hiding (TyCon) +import Data.Versions (SemVer (..), Versioning (..)) import Data.Void import Data.Word import GHC.Base (assert) @@ -466,6 +468,11 @@ zip4Exact [] [] [] [] = [] zip4Exact (x1 : t1) (x2 : t2) (x3 : t3) (x4 : t4) = (x1, x2, x3, x4) : zip4Exact t1 t2 t3 t4 zip4Exact _ _ _ _ = error "zip4Exact" +findJustM :: forall a b m. (Monad m) => (a -> m (Maybe b)) -> [a] -> m (Maybe b) +findJustM f = \case + [] -> return Nothing + x : xs -> f x >>= maybe (findJustM f xs) (return . Just) + -- | Returns the first element that returns Just and the list with the remaining elements findJustAndRemove :: forall a b. (a -> Maybe b) -> [a] -> Maybe (b, [a]) findJustAndRemove p = go [] diff --git a/src/Juvix/Prelude/Effects/Base.hs b/src/Juvix/Prelude/Effects/Base.hs index 41dd47cef4..9c32c313e7 100644 --- a/src/Juvix/Prelude/Effects/Base.hs +++ b/src/Juvix/Prelude/Effects/Base.hs @@ -234,6 +234,14 @@ reinterpretH :: Sem r b reinterpretH = E.reinterpret +reinterpret' :: + (DispatchOf e ~ 'Dynamic) => + Sem (e ': r) a -> + (Sem handlerEs a -> Sem r b) -> + EffectHandlerFO e handlerEs -> + Sem r b +reinterpret' m re i = reinterpret re i m + reinterpret :: (DispatchOf e ~ 'Dynamic) => (Sem handlerEs a -> Sem r b) -> diff --git a/src/Parallel/ProgressLog.hs b/src/Parallel/ProgressLog.hs index 18cb1f72d9..5fbd415043 100644 --- a/src/Parallel/ProgressLog.hs +++ b/src/Parallel/ProgressLog.hs @@ -68,6 +68,7 @@ runProgressLog :: '[ PathResolver, Reader ImportTree, Reader PipelineOptions, + Reader GlobalVersions, Logger, Concurrent ] @@ -91,7 +92,7 @@ runProgressLog m = do runProgressLogOptions :: forall r a. - (Members '[Logger, Concurrent] r) => + (Members '[Logger, Concurrent, Reader GlobalVersions] r) => ProgressLogOptions -> Sem (ProgressLog ': r) a -> Sem r a @@ -104,8 +105,8 @@ runProgressLogOptions opts m = do wait logHandler return x where - getPackageTag :: Path Abs Dir -> Doc CodeAnn - getPackageTag pkgRoot = opts ^. progressLogOptionsPackages . at pkgRoot . _Just . packagePackage . packageLikeNameAndVersion + getPackageTag :: Path Abs Dir -> Sem r (Doc CodeAnn) + getPackageTag pkgRoot = packageLikeNameAndVersion (opts ^?! progressLogOptionsPackages . at pkgRoot . _Just . packagePackage) tree :: ImportTree tree = opts ^. progressLogOptionsImportTree @@ -160,12 +161,13 @@ runProgressLogOptions opts m = do handler :: TVar ProgressLogState -> LogQueue -> EffectHandlerFO ProgressLog r handler st logs = \case - ProgressLog i -> + ProgressLog i -> do + tag <- getPackageTag fromPackage atomically $ do n <- getNextNumber let k | fromMainPackage = LogMainPackage - | otherwise = LogDependency (getPackageTag fromPackage) + | otherwise = LogDependency tag d = LogItemDetails { _logItemDetailsKind = k, From df62ccda4df585190bec10efb1587116b092d9de Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Sun, 1 Dec 2024 18:11:59 +0100 Subject: [PATCH 02/25] fix loop --- src/Juvix/Data/SHA256.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Juvix/Data/SHA256.hs b/src/Juvix/Data/SHA256.hs index fc569e69ab..1af517989a 100644 --- a/src/Juvix/Data/SHA256.hs +++ b/src/Juvix/Data/SHA256.hs @@ -41,7 +41,7 @@ runSHA256Builder m = fmap $ \case BuilderDigestFiles f -> do fs <- mapM readFileBS' (toList f) - modify (\ctx -> SHA256.updates ctx (toList fs)) + modify (`SHA256.updates` fs) ignoreSHA256Builder :: Sem (SHA256Builder ': r) a -> Sem r a ignoreSHA256Builder = interpret $ \case @@ -52,4 +52,4 @@ execSHA256Builder = fmap fst . runSHA256Builder -- | Create a HEX encoded, SHA256 digest of the contents of some files digestFiles :: (Members '[Files] r, Foldable l) => l (Path Abs File) -> Sem r Text -digestFiles = execSHA256Builder . digestFiles +digestFiles = execSHA256Builder . builderDigestFiles From 389c56f946ce4d6d9073befb4fb4e1c0efc65e28 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Sun, 1 Dec 2024 18:12:44 +0100 Subject: [PATCH 03/25] rename _moduleIdPackageName --- .../Concrete/Translation/FromParsed/Analysis/Scoping.hs | 2 +- src/Juvix/Data/ModuleId.hs | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs index b847e6ff8a..074a1570a3 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs @@ -960,7 +960,7 @@ getModuleId path = do return ModuleId { _moduleIdPath = path, - _moduleIdPackage = pkg ^. packageIdName, + _moduleIdPackageName = pkg ^. packageIdName, _moduleIdPackageVersion = show (pkg ^. packageIdVersion) } diff --git a/src/Juvix/Data/ModuleId.hs b/src/Juvix/Data/ModuleId.hs index 29818e43fb..4ee06a01a5 100644 --- a/src/Juvix/Data/ModuleId.hs +++ b/src/Juvix/Data/ModuleId.hs @@ -7,7 +7,7 @@ import Prettyprinter data ModuleId = ModuleId { _moduleIdPath :: TopModulePathKey, - _moduleIdPackage :: Text, + _moduleIdPackageName :: Text, _moduleIdPackageVersion :: Text } deriving stock (Show, Eq, Ord, Generic, Data) @@ -27,6 +27,6 @@ defaultModuleId :: ModuleId defaultModuleId = ModuleId { _moduleIdPath = nonEmptyToTopModulePathKey (pure "$DefaultModule$"), - _moduleIdPackage = "$", + _moduleIdPackageName = "$", _moduleIdPackageVersion = "1.0" } From 1243fa3139399e664d524bc89d36896d507ab4e6 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Sun, 1 Dec 2024 18:13:42 +0100 Subject: [PATCH 04/25] derive Ord --- src/Juvix/Compiler/Pipeline/Package/Base.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Juvix/Compiler/Pipeline/Package/Base.hs b/src/Juvix/Compiler/Pipeline/Package/Base.hs index 4ea8bbea9c..687caff448 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Base.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Base.hs @@ -48,7 +48,7 @@ data PackageId = PackageId { _packageIdName :: Text, _packageIdVersion :: SemVer } - deriving stock (Show, Eq) + deriving stock (Show, Ord, Eq) data Package' (s :: IsProcessed) = Package { _packageName :: NameType s, From 1b98a360cdd44b2631a44eaed91b17fe1e409465 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Sun, 1 Dec 2024 18:15:12 +0100 Subject: [PATCH 05/25] importNodePackageId --- src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs index 1d2f8ddab9..d3f74523c5 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs @@ -11,6 +11,7 @@ module Juvix.Compiler.Pipeline.Loader.PathResolver evalPathResolverPipe, findPackageJuvixFiles, runGlobalVersions, + importNodePackageId, ) where @@ -384,6 +385,11 @@ isModuleOrphan topJuvixPath = do && not (pathPackageBase `isProperPrefixOf` actualPath) ) +importNodePackageId :: (Members '[Reader GlobalVersions, PathResolver] r) => ImportNode -> Sem r PackageId +importNodePackageId n = do + pkg <- fromJust . (^. at (n ^. importNodePackageRoot)) <$> getPackageInfos + packageLikePackageId (pkg ^. packagePackage) + expectedPath' :: (Members '[Reader ResolverEnv, Files] r) => TopModulePath -> From 76f9c240981c989144dbfeb8bd9ad4f4d9a9d1ff Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Sun, 1 Dec 2024 18:31:31 +0100 Subject: [PATCH 06/25] mkEntryIndex changes packageId --- src/Juvix/Compiler/Pipeline/Driver.hs | 23 +++++--- src/Juvix/Compiler/Pipeline/DriverParallel.hs | 3 +- .../Compiler/Pipeline/Loader/PathResolver.hs | 57 ++++++++++++------- .../Compiler/Pipeline/ModuleInfoCache.hs | 6 +- src/Juvix/Compiler/Pipeline/Repl.hs | 4 +- src/Juvix/Compiler/Pipeline/Run.hs | 4 +- 6 files changed, 60 insertions(+), 37 deletions(-) diff --git a/src/Juvix/Compiler/Pipeline/Driver.hs b/src/Juvix/Compiler/Pipeline/Driver.hs index 5974724edd..53b3554cad 100644 --- a/src/Juvix/Compiler/Pipeline/Driver.hs +++ b/src/Juvix/Compiler/Pipeline/Driver.hs @@ -95,10 +95,11 @@ evalModuleInfoCachePackageDotJuvix :: ] r ) => - Sem (ModuleInfoCache ': ProgressLog ': JvoCache ': r) a -> + Sem (ModuleInfoCache ': ProgressLog ': JvoCache ': Reader GlobalVersions ': r) a -> Sem r a evalModuleInfoCachePackageDotJuvix = - evalJvoCache + runReader (GlobalVersions Nothing) + . evalJvoCache . ignoreProgressLog . evalCacheEmpty processModuleCacheMiss @@ -109,6 +110,7 @@ compileSequentially :: '[ ModuleInfoCache, Reader EntryPoint, PathResolver, + Reader GlobalVersions, Reader ImportTree ] r @@ -185,6 +187,7 @@ processModuleCacheMissDecide :: Error JuvixError, Files, JvoCache, + Reader GlobalVersions, PathResolver ] r, @@ -195,6 +198,7 @@ processModuleCacheMissDecide :: TaggedLock, TopModuleNameChecker, HighlightBuilder, + Reader GlobalVersions, PathResolver ] rrecompile @@ -260,6 +264,7 @@ processModuleCacheMiss :: JvoCache, ProgressLog, Concurrent, + Reader GlobalVersions, PathResolver ] r @@ -276,7 +281,7 @@ processModuleCacheMiss entryIx = do return r ProcessModuleRecompile recomp -> recomp ^. recompileDo -processProject :: (Members '[ModuleInfoCache, Reader EntryPoint, Reader ImportTree] r) => Sem r [(ImportNode, PipelineResult ModuleInfo)] +processProject :: (Members '[PathResolver, Reader GlobalVersions, ModuleInfoCache, Reader EntryPoint, Reader ImportTree] r) => Sem r [(ImportNode, PipelineResult ModuleInfo)] processProject = do rootDir <- asks (^. entryPointRoot) nodes <- toList <$> asks (importTreeProjectNodes rootDir) @@ -328,7 +333,7 @@ processRecursiveUpToTyped = do processImport :: forall r. - (Members '[ModuleInfoCache, Reader EntryPoint, Error JuvixError, Files, PathResolver] r) => + (Members '[Reader GlobalVersions, ModuleInfoCache, Reader EntryPoint, Error JuvixError, Files, PathResolver] r) => TopModulePath -> Sem r (PipelineResult Store.ModuleInfo) processImport p = withPathFile p getCachedImport @@ -345,7 +350,7 @@ processImport p = withPathFile p getCachedImport processFileUpToParsing :: forall r. - (Members '[ModuleInfoCache, Reader EntryPoint, HighlightBuilder, TopModuleNameChecker, Error JuvixError, Files, PathResolver] r) => + (Members '[ModuleInfoCache, Reader GlobalVersions, Reader EntryPoint, HighlightBuilder, TopModuleNameChecker, Error JuvixError, Files, PathResolver] r) => EntryPoint -> Sem r (PipelineResult Parser.ParserResult) processFileUpToParsing entry = do @@ -361,7 +366,7 @@ processFileUpToParsing entry = do processFileUpTo :: forall r a. - (Members '[Reader EntryPoint, Error JuvixError, TopModuleNameChecker, PathResolver, Files, HighlightBuilder, ModuleInfoCache] r) => + (Members '[Reader GlobalVersions, Reader EntryPoint, Error JuvixError, TopModuleNameChecker, PathResolver, Files, HighlightBuilder, ModuleInfoCache] r) => Sem (Reader Parser.ParserResult ': Reader Store.ModuleTable ': NameIdGen ': r) a -> Sem r (PipelineResult a) processFileUpTo a = do @@ -378,7 +383,7 @@ processFileUpTo a = do processImports :: forall r. - (Members '[Reader EntryPoint, ModuleInfoCache, Error JuvixError, Files, PathResolver] r) => + (Members '[Reader GlobalVersions, Reader EntryPoint, ModuleInfoCache, Error JuvixError, Files, PathResolver] r) => [TopModulePath] -> Sem r CompileResult processImports imports = do @@ -395,7 +400,7 @@ processImports imports = do processModuleToStoredCore :: forall r. - (Members '[ModuleInfoCache, PathResolver, HighlightBuilder, TopModuleNameChecker, Error JuvixError, Files] r) => + (Members '[Reader GlobalVersions, ModuleInfoCache, PathResolver, HighlightBuilder, TopModuleNameChecker, Error JuvixError, Files] r) => Text -> EntryPoint -> Sem r (PipelineResult Store.ModuleInfo) @@ -417,7 +422,7 @@ processModuleToStoredCore sha256 entry = over pipelineResult mkModuleInfo <$> pr processFileToStoredCore :: forall r. - (Members '[ModuleInfoCache, HighlightBuilder, PathResolver, TopModuleNameChecker, Error JuvixError, Files] r) => + (Members '[Reader GlobalVersions, ModuleInfoCache, HighlightBuilder, PathResolver, TopModuleNameChecker, Error JuvixError, Files] r) => EntryPoint -> Sem r (PipelineResult Core.CoreResult) processFileToStoredCore entry = runReader entry $ do diff --git a/src/Juvix/Compiler/Pipeline/DriverParallel.hs b/src/Juvix/Compiler/Pipeline/DriverParallel.hs index cc0f4b8eec..b2625a57cf 100644 --- a/src/Juvix/Compiler/Pipeline/DriverParallel.hs +++ b/src/Juvix/Compiler/Pipeline/DriverParallel.hs @@ -33,7 +33,7 @@ type Node = EntryIndex mkNodesIndex :: forall r. - (Members '[Reader EntryPoint] r) => + (Members '[PathResolver, Reader GlobalVersions, Reader EntryPoint] r) => ImportTree -> Sem r (NodesIndex ImportNode Node) mkNodesIndex tree = @@ -77,6 +77,7 @@ compileInParallel :: Reader EntryPoint, PathResolver, Reader NumThreads, + Reader GlobalVersions, Reader ImportTree ] r diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs index d3f74523c5..524cd30f32 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs @@ -38,8 +38,14 @@ import Juvix.Extra.Paths import Juvix.Extra.Stdlib (ensureStdlib) import Juvix.Prelude -runGlobalVersions :: forall r a. (Members '[PathResolver, Files, TaggedLock, Error JuvixError, EvalFileEff] r) => Sem (Reader GlobalVersions ': r) a -> Sem r a -runGlobalVersions m = do +runGlobalVersions :: + forall r a. + (Members '[PathResolver, Files, TaggedLock, Error JuvixError, EvalFileEff] r) => + Text -> + Sem (Reader GlobalVersions ': r) a -> + Sem r a +runGlobalVersions txt m = do + traceM ("runGlobalVersions " <> txt) infos <- toList <$> getPackageInfos globalVer <- findJustM getGlobalPkgVersion infos let g = @@ -189,27 +195,36 @@ registerDependencies' conf = do initialized <- gets (^. resolverInitialized) unless initialized $ do modify (set resolverInitialized True) - e <- ask @EntryPoint + registerDepsFromRoot + checkConflicts mapError (JuvixError @ParserError) registerPackageBase - case e ^. entryPointPackageType of - GlobalStdlib -> do - glob <- globalRoot - void (addRootDependency conf e glob) - GlobalPackageBase -> return () - GlobalPackageDescription -> void (addRootDependency conf e (e ^. entryPointRoot)) - LocalPackage -> do - lockfile <- addRootDependency conf e (e ^. entryPointRoot) - whenM shouldWriteLockfile $ do - let root :: Path Abs Dir = e ^. entryPointSomeRoot . someRootDir - packagePath :: Path Abs File <- do - let packageDotJuvix = mkPackagePath root - juvixDotYaml = mkPackageFilePath root - x <- findM fileExists' [packageDotJuvix, juvixDotYaml] - return (fromMaybe (error ("No package file found in " <> show root)) x) - packageFileChecksum <- SHA256.digestFile packagePath - lockfilePath' <- lockfilePath - writeLockfile lockfilePath' packageFileChecksum lockfile where + -- Checks that no two different roots have the same PackageId + checkConflicts :: Sem r () + checkConflicts = do + return () + + registerDepsFromRoot = do + e <- ask + case e ^. entryPointPackageType of + GlobalStdlib -> do + glob <- globalRoot + void (addRootDependency conf e glob) + GlobalPackageBase -> return () + GlobalPackageDescription -> void (addRootDependency conf e (e ^. entryPointRoot)) + LocalPackage -> do + lockfile <- addRootDependency conf e (e ^. entryPointRoot) + whenM shouldWriteLockfile $ do + let root :: Path Abs Dir = e ^. entryPointSomeRoot . someRootDir + packagePath :: Path Abs File <- do + let packageDotJuvix = mkPackagePath root + juvixDotYaml = mkPackageFilePath root + x <- findM fileExists' [packageDotJuvix, juvixDotYaml] + return (fromMaybe (error ("No package file found in " <> show root)) x) + packageFileChecksum <- SHA256.digestFile packagePath + lockfilePath' <- lockfilePath + writeLockfile lockfilePath' packageFileChecksum lockfile + shouldWriteLockfile :: Sem r Bool shouldWriteLockfile = do lockfileExists <- lockfilePath >>= fileExists' diff --git a/src/Juvix/Compiler/Pipeline/ModuleInfoCache.hs b/src/Juvix/Compiler/Pipeline/ModuleInfoCache.hs index 3e5e1f2510..ccbfff39d2 100644 --- a/src/Juvix/Compiler/Pipeline/ModuleInfoCache.hs +++ b/src/Juvix/Compiler/Pipeline/ModuleInfoCache.hs @@ -1,7 +1,7 @@ module Juvix.Compiler.Pipeline.ModuleInfoCache where import Juvix.Compiler.Pipeline.EntryPoint -import Juvix.Compiler.Pipeline.Loader.PathResolver.ImportTree.ImportNode +import Juvix.Compiler.Pipeline.Loader.PathResolver import Juvix.Compiler.Pipeline.Result import Juvix.Compiler.Store.Language qualified as Store import Juvix.Data.Effect.Cache @@ -28,9 +28,10 @@ entryIndexPath = fromMaybe err . (^. entryIxEntry . entryPointModulePath) err :: a err = error "unexpected: EntryIndex should always have a path" -mkEntryIndex :: (Members '[Reader EntryPoint] r) => ImportNode -> Sem r EntryIndex +mkEntryIndex :: (Members '[Reader GlobalVersions, PathResolver, Reader EntryPoint] r) => ImportNode -> Sem r EntryIndex mkEntryIndex node = do entry <- ask + pkgId <- importNodePackageId node let path = node ^. importNodeAbsFile stdin' | Just path == entry ^. entryPointModulePath = entry ^. entryPointStdin @@ -38,6 +39,7 @@ mkEntryIndex node = do entry' = entry { _entryPointStdin = stdin', + _entryPointPackageId = pkgId, _entryPointModulePath = Just path } return diff --git a/src/Juvix/Compiler/Pipeline/Repl.hs b/src/Juvix/Compiler/Pipeline/Repl.hs index 793761a8d8..30c352bad3 100644 --- a/src/Juvix/Compiler/Pipeline/Repl.hs +++ b/src/Juvix/Compiler/Pipeline/Repl.hs @@ -118,7 +118,7 @@ compileExpression p = >>= fromInternalExpression registerImport :: - (Members '[TaggedLock, Error JuvixError, State Artifacts, Reader EntryPoint, Files, GitClone, PathResolver, ModuleInfoCache] r) => + (Members '[TaggedLock, Reader GlobalVersions, Error JuvixError, State Artifacts, Reader EntryPoint, Files, GitClone, PathResolver, ModuleInfoCache] r) => Import 'Parsed -> Sem r () registerImport i = do @@ -180,7 +180,7 @@ compileReplInputIO fp txt = do . runTopModuleNameChecker . runReader defaultImportScanStrategy . withImportTree (Just fp) - . runGlobalVersions + . runGlobalVersions "repl" . evalModuleInfoCacheHelper $ do p <- parseReplInput fp txt diff --git a/src/Juvix/Compiler/Pipeline/Run.hs b/src/Juvix/Compiler/Pipeline/Run.hs index f4df134629..8ae9096896 100644 --- a/src/Juvix/Compiler/Pipeline/Run.hs +++ b/src/Juvix/Compiler/Pipeline/Run.hs @@ -126,7 +126,7 @@ runIOEitherPipeline' entry a = do . runDependencyResolver . runReader (opts ^. pipelineDependenciesConfig) . runPathResolverInput - . runGlobalVersions + . runGlobalVersions "runIOEitherPipeline'" . runTopModuleNameChecker . runReader (opts ^. pipelineImportStrategy) . withImportTree (entry ^. entryPointModulePath) @@ -236,7 +236,7 @@ runReplPipelineIOEither' lockMode entry = do . runTopModuleNameChecker . runReader defaultImportScanStrategy . withImportTree (entry ^. entryPointModulePath) - . runGlobalVersions + . runGlobalVersions "runReplPipeline" . evalModuleInfoCacheHelper $ processFileToStoredCore entry return $ case eith of From f9856fa0e0dfbd49e0a0f63207168f990b91443d Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Sun, 1 Dec 2024 18:38:10 +0100 Subject: [PATCH 07/25] groupSortOnWith --- src/Juvix/Prelude/Base.hs | 35 ++++++++++++++++++++++++++++ src/Juvix/Prelude/Base/Foundation.hs | 18 -------------- src/Juvix/Prelude/Effects/Input.hs | 2 +- 3 files changed, 36 insertions(+), 19 deletions(-) diff --git a/src/Juvix/Prelude/Base.hs b/src/Juvix/Prelude/Base.hs index fd6fbe733c..fdf82a4c1b 100644 --- a/src/Juvix/Prelude/Base.hs +++ b/src/Juvix/Prelude/Base.hs @@ -1,8 +1,43 @@ module Juvix.Prelude.Base ( module Juvix.Prelude.Base.Foundation, module Juvix.Prelude.Effects, + module Juvix.Prelude.Base, ) where import Juvix.Prelude.Base.Foundation import Juvix.Prelude.Effects + +groupSortOnWith :: forall a b. (Ord b) => (a -> b) -> [a] -> [(NonEmpty a, b)] +groupSortOnWith f l = run . execAccumList . runInputList (sortOn snd (mapWith f l)) $ repeatOnInput go + where + go :: forall r. (Members '[Input (a, b), Accum (NonEmpty a, b)] r) => (a, b) -> Sem r () + go (e, eb) = do + es <- map fst <$> inputWhile @(a, b) ((== eb) . snd) + accum (e :| es, eb) + +groupSortOn :: (Ord b) => (a -> b) -> [a] -> [NonEmpty a] +groupSortOn f = map fst . groupSortOnWith f + +groupSortOn' :: (Ord b) => (a -> b) -> [a] -> [[a]] +groupSortOn' f = map toList . groupSortOn f + +findRepeatedOn :: forall a b. (Ord b) => (a -> b) -> [a] -> [(NonEmpty a, b)] +findRepeatedOn f = mapMaybe rep . groupSortOnWith f + where + rep :: (NonEmpty a, b) -> Maybe (NonEmpty a, b) + rep = \case + (n@(_ :| _ : _), b) -> Just (n, b) + _ -> Nothing + +-- | Returns the repeated elements +findRepeated :: forall a. (Ord a) => [a] -> [a] +findRepeated = mapMaybe rep . groupSortOn id + where + rep :: NonEmpty a -> Maybe a + rep = \case + (a :| _ : _) -> Just a + _ -> Nothing + +allDifferent :: forall a. (Ord a) => [a] -> Bool +allDifferent = null . findRepeated diff --git a/src/Juvix/Prelude/Base/Foundation.hs b/src/Juvix/Prelude/Base/Foundation.hs index d2115091f2..4b571d62bf 100644 --- a/src/Juvix/Prelude/Base/Foundation.hs +++ b/src/Juvix/Prelude/Base/Foundation.hs @@ -341,18 +341,6 @@ replaceText texts txt = fromMaybe txt (HashMap.lookup txt (HashMap.fromList text -- Foldable -------------------------------------------------------------------------------- --- | Returns the repeated elements -findRepeated :: forall a. (Ord a) => [a] -> [a] -findRepeated = mapMaybe rep . groupSortOn' id - where - rep :: [a] -> Maybe a - rep = \case - a : _ : _ -> Just a - _ -> Nothing - -allDifferent :: forall a. (Ord a) => [a] -> Bool -allDifferent = null . findRepeated - allSame :: forall t a. (Eq a, Foldable t) => t a -> Bool allSame t = case nonEmpty t of Nothing -> True @@ -510,12 +498,6 @@ nonEmpty' = fromJust . nonEmpty _nonEmpty :: Lens' [a] (Maybe (NonEmpty a)) _nonEmpty f x = maybe [] toList <$> f (nonEmpty x) -groupSortOn :: (Ord b) => (a -> b) -> [a] -> [NonEmpty a] -groupSortOn f = map nonEmpty' . List.groupSortOn f - -groupSortOn' :: (Ord b) => (a -> b) -> [a] -> [[a]] -groupSortOn' = List.groupSortOn - -------------------------------------------------------------------------------- -- Errors -------------------------------------------------------------------------------- diff --git a/src/Juvix/Prelude/Effects/Input.hs b/src/Juvix/Prelude/Effects/Input.hs index d2f1f6fe25..616287d164 100644 --- a/src/Juvix/Prelude/Effects/Input.hs +++ b/src/Juvix/Prelude/Effects/Input.hs @@ -31,7 +31,7 @@ input = Input [] -> (Nothing, Input []) Input (i : is) -> (Just i, Input is) -inputWhile :: (Member (Input i) r) => (i -> Bool) -> Sem r [i] +inputWhile :: forall i r. (Member (Input i) r) => (i -> Bool) -> Sem r [i] inputWhile c = stateStaticRep $ \case From e816821d015a30c396294931603d17148785a2f9 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 2 Dec 2024 09:56:29 +0100 Subject: [PATCH 08/25] use PackageId in ModuleId instead of Text for name and version --- .../Concrete/Translation/FromParsed.hs | 1 - .../FromParsed/Analysis/Scoping.hs | 6 ++-- .../Compiler/Core/Language/Primitives.hs | 1 - .../Compiler/Pipeline/Loader/PathResolver.hs | 26 ++++++++++++----- src/Juvix/Compiler/Pipeline/Package/Base.hs | 18 ------------ src/Juvix/Compiler/Store/Core/Language.hs | 5 ++-- src/Juvix/Data.hs | 2 ++ src/Juvix/Data/ModuleId.hs | 11 +++++--- src/Juvix/Data/PackageId.hs | 28 +++++++++++++++++++ src/Juvix/Extra/Serialize.hs | 7 ----- src/Juvix/Prelude/Base.hs | 19 ++++++++++--- src/Juvix/Prelude/Base/Foundation.hs | 18 ++++++++++++ 12 files changed, 93 insertions(+), 49 deletions(-) create mode 100644 src/Juvix/Data/PackageId.hs diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed.hs index beae4e8189..0c73734a88 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed.hs @@ -10,7 +10,6 @@ import Juvix.Compiler.Concrete.Language import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Data.Context import Juvix.Compiler.Concrete.Translation.FromSource.Data.Context qualified as Parsed -import Juvix.Compiler.Pipeline.EntryPoint import Juvix.Compiler.Store.Extra import Juvix.Compiler.Store.Language import Juvix.Prelude diff --git a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs index 074a1570a3..37d87ea42b 100644 --- a/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs +++ b/src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/Scoping.hs @@ -24,7 +24,6 @@ import Juvix.Compiler.Concrete.Pretty (ppTrace) import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Data.Context import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error import Juvix.Compiler.Concrete.Translation.FromSource.Data.Context qualified as Parser -import Juvix.Compiler.Pipeline.EntryPoint import Juvix.Compiler.Store.Scoped.Language as Store import Juvix.Data.FixityInfo qualified as FI import Juvix.Prelude @@ -956,12 +955,11 @@ checkFixityInfo ParsedFixityInfo {..} = do getModuleId :: forall r. (Member (Reader PackageId) r) => TopModulePathKey -> Sem r ModuleId getModuleId path = do - pkg <- ask + pkgId <- ask return ModuleId { _moduleIdPath = path, - _moduleIdPackageName = pkg ^. packageIdName, - _moduleIdPackageVersion = show (pkg ^. packageIdVersion) + _moduleIdPackageId = pkgId } checkFixitySyntaxDef :: diff --git a/src/Juvix/Compiler/Core/Language/Primitives.hs b/src/Juvix/Compiler/Core/Language/Primitives.hs index 19fb5ba6a5..3cbd68d55c 100644 --- a/src/Juvix/Compiler/Core/Language/Primitives.hs +++ b/src/Juvix/Compiler/Core/Language/Primitives.hs @@ -7,7 +7,6 @@ represented by booleans, any type isomorphic to unary natural numbers may be represented by integers with minimum value 0. -} import Juvix.Compiler.Core.Language.Base -import Juvix.Extra.Serialize -- | Primitive type representation. data Primitive diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs index 524cd30f32..8acdc65e73 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs @@ -17,6 +17,7 @@ where import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet +import Data.Text qualified as Text import Juvix.Compiler.Concrete.Data.Name import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error import Juvix.Compiler.Concrete.Translation.ImportScanner @@ -52,8 +53,25 @@ runGlobalVersions txt m = do GlobalVersions { _globalVersionsStdlib = globalVer } - runReader g m + runReader g (checkConflicts >> m) where + -- Checks that no two different roots have the same PackageId + checkConflicts :: forall r'. (Members '[Reader GlobalVersions, PathResolver] r') => Sem r' () + checkConflicts = do + pkgs :: [PackageInfo] <- toList <$> getPackageInfos + reps <- findRepeatedOnM (packageLikePackageId . (^. packagePackage)) pkgs + case nonEmpty reps of + Just (rep :| _) -> errRep rep + Nothing -> return () + where + errRep :: (NonEmpty PackageInfo, PackageId) -> Sem r' () + errRep (l, pid) = + error $ + "Non-unique package id: " + <> show pid + <> "\n" + <> Text.unlines (l ^.. to toList . each . packageRoot . to toFilePath) + getGlobalPkgVersion :: PackageInfo -> Sem r (Maybe SemVer) getGlobalPkgVersion pkginfo = runFail $ do PackageGlobalStdlib <- pure (pkginfo ^. packagePackage) @@ -196,14 +214,8 @@ registerDependencies' conf = do unless initialized $ do modify (set resolverInitialized True) registerDepsFromRoot - checkConflicts mapError (JuvixError @ParserError) registerPackageBase where - -- Checks that no two different roots have the same PackageId - checkConflicts :: Sem r () - checkConflicts = do - return () - registerDepsFromRoot = do e <- ask case e ^. entryPointPackageType of diff --git a/src/Juvix/Compiler/Pipeline/Package/Base.hs b/src/Juvix/Compiler/Pipeline/Package/Base.hs index 687caff448..1651152d2e 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Base.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Base.hs @@ -11,7 +11,6 @@ import Data.Versions hiding (Lens') import Juvix.Compiler.Pipeline.Lockfile import Juvix.Compiler.Pipeline.Package.Dependency import Juvix.Extra.Paths -import Juvix.Extra.Strings qualified as Str import Juvix.Prelude data BuildDir @@ -44,12 +43,6 @@ type family PackageLockfileType s = res | res -> s where PackageLockfileType 'Raw = Maybe () PackageLockfileType 'Processed = Maybe LockfileInfo -data PackageId = PackageId - { _packageIdName :: Text, - _packageIdVersion :: SemVer - } - deriving stock (Show, Ord, Eq) - data Package' (s :: IsProcessed) = Package { _packageName :: NameType s, _packageVersion :: VersionType s, @@ -62,7 +55,6 @@ data Package' (s :: IsProcessed) = Package deriving stock (Generic) makeLenses ''Package' -makeLenses ''PackageId type Package = Package' 'Processed @@ -159,9 +151,6 @@ rawPackage pkg = _packageLockfile = Nothing } -defaultVersion :: SemVer -defaultVersion = SemVer 0 0 0 Nothing Nothing - unsetPackageLockfile :: Package -> Package unsetPackageLockfile = set packageLockfile Nothing @@ -183,13 +172,6 @@ globalPackage p = _packageLockfile = Nothing } -packageBaseId :: PackageId -packageBaseId = - PackageId - { _packageIdName = Str.packageBase, - _packageIdVersion = defaultVersion - } - mkPackageFilePath :: Path Abs Dir -> Path Abs File mkPackageFilePath = ( juvixYamlFile) diff --git a/src/Juvix/Compiler/Store/Core/Language.hs b/src/Juvix/Compiler/Store/Core/Language.hs index 3313fbf45f..b819588696 100644 --- a/src/Juvix/Compiler/Store/Core/Language.hs +++ b/src/Juvix/Compiler/Store/Core/Language.hs @@ -5,11 +5,10 @@ module Juvix.Compiler.Store.Core.Language where import Juvix.Compiler.Core.Language.Nodes -import Juvix.Extra.Serialize {---------------------------------------------------------------------------------} -data LetRecInfo = LetRecInfo +newtype LetRecInfo = LetRecInfo { _letRecInfoPragmas :: [Pragmas] } deriving stock (Generic) @@ -18,7 +17,7 @@ instance Serialize LetRecInfo instance NFData LetRecInfo -data LambdaInfo = LambdaInfo +newtype LambdaInfo = LambdaInfo { _lambdaInfoPragma :: Pragmas } deriving stock (Generic) diff --git a/src/Juvix/Data.hs b/src/Juvix/Data.hs index 6342d658cc..bfacc8c359 100644 --- a/src/Juvix/Data.hs +++ b/src/Juvix/Data.hs @@ -1,6 +1,7 @@ module Juvix.Data ( module Juvix.Data.Effect, module Juvix.Data.Error, + module Juvix.Data.PackageId, module Juvix.Data.ProjectionKind, module Juvix.Data.NumThreads, module Juvix.Data.Fixity, @@ -41,6 +42,7 @@ import Juvix.Data.Keyword import Juvix.Data.Loc import Juvix.Data.NameId qualified import Juvix.Data.NumThreads +import Juvix.Data.PackageId import Juvix.Data.ParsedItem import Juvix.Data.Polarity import Juvix.Data.Pragmas diff --git a/src/Juvix/Data/ModuleId.hs b/src/Juvix/Data/ModuleId.hs index 4ee06a01a5..b0e4f13540 100644 --- a/src/Juvix/Data/ModuleId.hs +++ b/src/Juvix/Data/ModuleId.hs @@ -1,5 +1,6 @@ module Juvix.Data.ModuleId where +import Juvix.Data.PackageId import Juvix.Data.TopModulePathKey import Juvix.Extra.Serialize import Juvix.Prelude.Base @@ -7,8 +8,7 @@ import Prettyprinter data ModuleId = ModuleId { _moduleIdPath :: TopModulePathKey, - _moduleIdPackageName :: Text, - _moduleIdPackageVersion :: Text + _moduleIdPackageId :: PackageId } deriving stock (Show, Eq, Ord, Generic, Data) @@ -27,6 +27,9 @@ defaultModuleId :: ModuleId defaultModuleId = ModuleId { _moduleIdPath = nonEmptyToTopModulePathKey (pure "$DefaultModule$"), - _moduleIdPackageName = "$", - _moduleIdPackageVersion = "1.0" + _moduleIdPackageId = + PackageId + { _packageIdName = "$", + _packageIdVersion = SemVer 1 0 0 Nothing Nothing + } } diff --git a/src/Juvix/Data/PackageId.hs b/src/Juvix/Data/PackageId.hs new file mode 100644 index 0000000000..74d3b9c67a --- /dev/null +++ b/src/Juvix/Data/PackageId.hs @@ -0,0 +1,28 @@ +module Juvix.Data.PackageId where + +import Juvix.Extra.Strings qualified as Str +import Juvix.Prelude.Base + +data PackageId = PackageId + { _packageIdName :: Text, + _packageIdVersion :: SemVer + } + deriving stock (Show, Ord, Eq, Data, Generic) + +makeLenses ''PackageId + +packageBaseId :: PackageId +packageBaseId = + PackageId + { _packageIdName = Str.packageBase, + _packageIdVersion = defaultVersion + } + +defaultVersion :: SemVer +defaultVersion = SemVer 0 0 0 Nothing Nothing + +instance Serialize PackageId + +instance Hashable PackageId + +instance NFData PackageId diff --git a/src/Juvix/Extra/Serialize.hs b/src/Juvix/Extra/Serialize.hs index a5d814aa6b..dd693c9554 100644 --- a/src/Juvix/Extra/Serialize.hs +++ b/src/Juvix/Extra/Serialize.hs @@ -19,13 +19,6 @@ import Juvix.Prelude.Path instance Serialize (Path Abs File) -instance Serialize Text where - put txt = Serial.put (unpack txt) - - get = pack <$> Serial.get - -instance (Serialize a) => Serialize (NonEmpty a) - instance (Hashable k, Serialize k, Serialize a) => Serialize (HashMap k a) where put m = Serial.put (HashMap.toList m) diff --git a/src/Juvix/Prelude/Base.hs b/src/Juvix/Prelude/Base.hs index fdf82a4c1b..0a07e0d544 100644 --- a/src/Juvix/Prelude/Base.hs +++ b/src/Juvix/Prelude/Base.hs @@ -8,28 +8,39 @@ where import Juvix.Prelude.Base.Foundation import Juvix.Prelude.Effects -groupSortOnWith :: forall a b. (Ord b) => (a -> b) -> [a] -> [(NonEmpty a, b)] -groupSortOnWith f l = run . execAccumList . runInputList (sortOn snd (mapWith f l)) $ repeatOnInput go +groupSortOnWithM :: forall a b m. (Ord b, Monad m) => (a -> m b) -> [a] -> m [(NonEmpty a, b)] +groupSortOnWithM f l = do + l' <- mapWithM f l + return (run . execAccumList . runInputList (sortOn snd l') $ repeatOnInput go) where go :: forall r. (Members '[Input (a, b), Accum (NonEmpty a, b)] r) => (a, b) -> Sem r () go (e, eb) = do es <- map fst <$> inputWhile @(a, b) ((== eb) . snd) accum (e :| es, eb) +groupSortOnWith :: forall a b. (Ord b) => (a -> b) -> [a] -> [(NonEmpty a, b)] +groupSortOnWith f = runIdentity . groupSortOnWithM (return . f) + +groupSortOnM :: (Ord b, Monad m) => (a -> m b) -> [a] -> m [NonEmpty a] +groupSortOnM f = fmap (map fst) . groupSortOnWithM f + groupSortOn :: (Ord b) => (a -> b) -> [a] -> [NonEmpty a] groupSortOn f = map fst . groupSortOnWith f groupSortOn' :: (Ord b) => (a -> b) -> [a] -> [[a]] groupSortOn' f = map toList . groupSortOn f -findRepeatedOn :: forall a b. (Ord b) => (a -> b) -> [a] -> [(NonEmpty a, b)] -findRepeatedOn f = mapMaybe rep . groupSortOnWith f +findRepeatedOnM :: forall a b m. (Ord b, Monad m) => (a -> m b) -> [a] -> m [(NonEmpty a, b)] +findRepeatedOnM f = fmap (mapMaybe rep) . groupSortOnWithM f where rep :: (NonEmpty a, b) -> Maybe (NonEmpty a, b) rep = \case (n@(_ :| _ : _), b) -> Just (n, b) _ -> Nothing +findRepeatedOn :: forall a b. (Ord b) => (a -> b) -> [a] -> [(NonEmpty a, b)] +findRepeatedOn f = runIdentity . findRepeatedOnM (return . f) + -- | Returns the repeated elements findRepeated :: forall a. (Ord a) => [a] -> [a] findRepeated = mapMaybe rep . groupSortOn id diff --git a/src/Juvix/Prelude/Base/Foundation.hs b/src/Juvix/Prelude/Base/Foundation.hs index 4b571d62bf..610cfbfc75 100644 --- a/src/Juvix/Prelude/Base/Foundation.hs +++ b/src/Juvix/Prelude/Base/Foundation.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -Wno-orphans #-} {-# OPTIONS_GHC -Wno-redundant-constraints #-} module Juvix.Prelude.Base.Foundation @@ -67,6 +68,7 @@ module Juvix.Prelude.Base.Foundation module Control.Monad.Catch, module Control.Monad.Zip, module Data.String.Interpolate, + module Data.Serialize, Data, Text, pack, @@ -175,6 +177,8 @@ import Data.Maybe import Data.Monoid import Data.Ord import Data.Semigroup (Semigroup, sconcat, (<>)) +import Data.Serialize (Serialize) +import Data.Serialize as Serial import Data.Set (Set) import Data.Set qualified as Set import Data.Singletons hiding ((@@)) @@ -198,6 +202,7 @@ import Data.Tuple.Extra hiding (both) import Data.Type.Equality (type (~)) import Data.Typeable hiding (TyCon) import Data.Versions (SemVer (..), Versioning (..)) +import Data.Versions qualified as Versions import Data.Void import Data.Word import GHC.Base (assert) @@ -901,3 +906,16 @@ allFiniteSequences elems = build 0 [] seq <- ofLength (n - 1) e <- elems return (pure e <> seq) + +instance Serialize Text where + put txt = Serial.put (unpack txt) + + get = pack <$> Serial.get + +instance (Serialize a) => Serialize (NonEmpty a) + +instance Serialize Versions.Chunk + +instance Serialize Versions.Release + +instance Serialize SemVer From 6b992849b32c36b695d80f6ebbe85a20637d6f62 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 2 Dec 2024 14:51:25 +0100 Subject: [PATCH 09/25] remove GlobalVersions --- src/Juvix/Compiler/Pipeline.hs | 2 - src/Juvix/Compiler/Pipeline/Driver.hs | 28 +++----- src/Juvix/Compiler/Pipeline/DriverParallel.hs | 4 +- .../Compiler/Pipeline/Loader/PathResolver.hs | 67 ++++++++++++------- .../Loader/PathResolver/GlobalVersions.hs | 11 --- .../Loader/PathResolver/PackageInfo.hs | 59 ++++++---------- .../Compiler/Pipeline/ModuleInfoCache.hs | 2 +- .../Pipeline/Package/Loader/PathResolver.hs | 4 +- src/Juvix/Compiler/Pipeline/Repl.hs | 2 +- src/Juvix/Compiler/Pipeline/Run.hs | 1 - src/Parallel/ProgressLog.hs | 9 ++- 11 files changed, 80 insertions(+), 109 deletions(-) delete mode 100644 src/Juvix/Compiler/Pipeline/Loader/PathResolver/GlobalVersions.hs diff --git a/src/Juvix/Compiler/Pipeline.hs b/src/Juvix/Compiler/Pipeline.hs index 955f4f66c0..c07827748b 100644 --- a/src/Juvix/Compiler/Pipeline.hs +++ b/src/Juvix/Compiler/Pipeline.hs @@ -41,7 +41,6 @@ import Juvix.Compiler.Pipeline.Loader.PathResolver.Base import Juvix.Compiler.Pipeline.Loader.PathResolver.Data import Juvix.Compiler.Pipeline.Loader.PathResolver.DependencyResolver import Juvix.Compiler.Pipeline.Loader.PathResolver.Error -import Juvix.Compiler.Pipeline.Loader.PathResolver.GlobalVersions import Juvix.Compiler.Pipeline.ModuleInfoCache import Juvix.Compiler.Pipeline.Options import Juvix.Compiler.Pipeline.Package.Loader.Error @@ -66,7 +65,6 @@ type PipelineLocalEff = Reader ImportTree, Reader ImportScanStrategy, TopModuleNameChecker, - Reader GlobalVersions, PathResolver, Reader DependenciesConfig, DependencyResolver, diff --git a/src/Juvix/Compiler/Pipeline/Driver.hs b/src/Juvix/Compiler/Pipeline/Driver.hs index 53b3554cad..7bdb65907a 100644 --- a/src/Juvix/Compiler/Pipeline/Driver.hs +++ b/src/Juvix/Compiler/Pipeline/Driver.hs @@ -71,7 +71,6 @@ evalModuleInfoCacheSequential :: Reader EntryPoint, Reader ImportTree, Reader PipelineOptions, - Reader GlobalVersions, PathResolver ] r @@ -95,11 +94,10 @@ evalModuleInfoCachePackageDotJuvix :: ] r ) => - Sem (ModuleInfoCache ': ProgressLog ': JvoCache ': Reader GlobalVersions ': r) a -> + Sem (ModuleInfoCache ': ProgressLog ': JvoCache ': r) a -> Sem r a evalModuleInfoCachePackageDotJuvix = - runReader (GlobalVersions Nothing) - . evalJvoCache + evalJvoCache . ignoreProgressLog . evalCacheEmpty processModuleCacheMiss @@ -110,7 +108,6 @@ compileSequentially :: '[ ModuleInfoCache, Reader EntryPoint, PathResolver, - Reader GlobalVersions, Reader ImportTree ] r @@ -143,7 +140,6 @@ evalModuleInfoCacheSetup :: Files, Reader ImportTree, Reader PipelineOptions, - Reader GlobalVersions, PathResolver ] r @@ -187,7 +183,6 @@ processModuleCacheMissDecide :: Error JuvixError, Files, JvoCache, - Reader GlobalVersions, PathResolver ] r, @@ -198,7 +193,6 @@ processModuleCacheMissDecide :: TaggedLock, TopModuleNameChecker, HighlightBuilder, - Reader GlobalVersions, PathResolver ] rrecompile @@ -264,7 +258,6 @@ processModuleCacheMiss :: JvoCache, ProgressLog, Concurrent, - Reader GlobalVersions, PathResolver ] r @@ -281,7 +274,7 @@ processModuleCacheMiss entryIx = do return r ProcessModuleRecompile recomp -> recomp ^. recompileDo -processProject :: (Members '[PathResolver, Reader GlobalVersions, ModuleInfoCache, Reader EntryPoint, Reader ImportTree] r) => Sem r [(ImportNode, PipelineResult ModuleInfo)] +processProject :: (Members '[PathResolver, ModuleInfoCache, Reader EntryPoint, Reader ImportTree] r) => Sem r [(ImportNode, PipelineResult ModuleInfo)] processProject = do rootDir <- asks (^. entryPointRoot) nodes <- toList <$> asks (importTreeProjectNodes rootDir) @@ -295,7 +288,6 @@ processRecursiveUpToTyped :: TaggedLock, HighlightBuilder, Error JuvixError, - Reader GlobalVersions, Files, PathResolver, ModuleInfoCache @@ -321,7 +313,7 @@ processRecursiveUpToTyped = do goImport :: ImportNode -> Sem r InternalTypedResult goImport node = do pkgInfo <- fromJust . HashMap.lookup (node ^. importNodePackageRoot) <$> getPackageInfos - pid <- packageLikePackageId (pkgInfo ^. packagePackage) + let pid = pkgInfo ^. packageInfoPackageId entry <- ask let entry' = entry @@ -333,7 +325,7 @@ processRecursiveUpToTyped = do processImport :: forall r. - (Members '[Reader GlobalVersions, ModuleInfoCache, Reader EntryPoint, Error JuvixError, Files, PathResolver] r) => + (Members '[ModuleInfoCache, Reader EntryPoint, Error JuvixError, Files, PathResolver] r) => TopModulePath -> Sem r (PipelineResult Store.ModuleInfo) processImport p = withPathFile p getCachedImport @@ -350,7 +342,7 @@ processImport p = withPathFile p getCachedImport processFileUpToParsing :: forall r. - (Members '[ModuleInfoCache, Reader GlobalVersions, Reader EntryPoint, HighlightBuilder, TopModuleNameChecker, Error JuvixError, Files, PathResolver] r) => + (Members '[ModuleInfoCache, Reader EntryPoint, HighlightBuilder, TopModuleNameChecker, Error JuvixError, Files, PathResolver] r) => EntryPoint -> Sem r (PipelineResult Parser.ParserResult) processFileUpToParsing entry = do @@ -366,7 +358,7 @@ processFileUpToParsing entry = do processFileUpTo :: forall r a. - (Members '[Reader GlobalVersions, Reader EntryPoint, Error JuvixError, TopModuleNameChecker, PathResolver, Files, HighlightBuilder, ModuleInfoCache] r) => + (Members '[Reader EntryPoint, Error JuvixError, TopModuleNameChecker, PathResolver, Files, HighlightBuilder, ModuleInfoCache] r) => Sem (Reader Parser.ParserResult ': Reader Store.ModuleTable ': NameIdGen ': r) a -> Sem r (PipelineResult a) processFileUpTo a = do @@ -383,7 +375,7 @@ processFileUpTo a = do processImports :: forall r. - (Members '[Reader GlobalVersions, Reader EntryPoint, ModuleInfoCache, Error JuvixError, Files, PathResolver] r) => + (Members '[Reader EntryPoint, ModuleInfoCache, Error JuvixError, Files, PathResolver] r) => [TopModulePath] -> Sem r CompileResult processImports imports = do @@ -400,7 +392,7 @@ processImports imports = do processModuleToStoredCore :: forall r. - (Members '[Reader GlobalVersions, ModuleInfoCache, PathResolver, HighlightBuilder, TopModuleNameChecker, Error JuvixError, Files] r) => + (Members '[ModuleInfoCache, PathResolver, HighlightBuilder, TopModuleNameChecker, Error JuvixError, Files] r) => Text -> EntryPoint -> Sem r (PipelineResult Store.ModuleInfo) @@ -422,7 +414,7 @@ processModuleToStoredCore sha256 entry = over pipelineResult mkModuleInfo <$> pr processFileToStoredCore :: forall r. - (Members '[Reader GlobalVersions, ModuleInfoCache, HighlightBuilder, PathResolver, TopModuleNameChecker, Error JuvixError, Files] r) => + (Members '[ModuleInfoCache, HighlightBuilder, PathResolver, TopModuleNameChecker, Error JuvixError, Files] r) => EntryPoint -> Sem r (PipelineResult Core.CoreResult) processFileToStoredCore entry = runReader entry $ do diff --git a/src/Juvix/Compiler/Pipeline/DriverParallel.hs b/src/Juvix/Compiler/Pipeline/DriverParallel.hs index b2625a57cf..395856a6bf 100644 --- a/src/Juvix/Compiler/Pipeline/DriverParallel.hs +++ b/src/Juvix/Compiler/Pipeline/DriverParallel.hs @@ -33,7 +33,7 @@ type Node = EntryIndex mkNodesIndex :: forall r. - (Members '[PathResolver, Reader GlobalVersions, Reader EntryPoint] r) => + (Members '[PathResolver, Reader EntryPoint] r) => ImportTree -> Sem r (NodesIndex ImportNode Node) mkNodesIndex tree = @@ -77,7 +77,6 @@ compileInParallel :: Reader EntryPoint, PathResolver, Reader NumThreads, - Reader GlobalVersions, Reader ImportTree ] r @@ -139,7 +138,6 @@ evalModuleInfoCacheParallel :: Reader ImportScanStrategy, Reader NumThreads, Reader PipelineOptions, - Reader GlobalVersions, Logger, Files ] diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs index 8acdc65e73..aa78c90ed4 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs @@ -39,27 +39,21 @@ import Juvix.Extra.Paths import Juvix.Extra.Stdlib (ensureStdlib) import Juvix.Prelude +-- | TODO rename and move somewhere else runGlobalVersions :: forall r a. (Members '[PathResolver, Files, TaggedLock, Error JuvixError, EvalFileEff] r) => Text -> - Sem (Reader GlobalVersions ': r) a -> + Sem r a -> Sem r a -runGlobalVersions txt m = do - traceM ("runGlobalVersions " <> txt) - infos <- toList <$> getPackageInfos - globalVer <- findJustM getGlobalPkgVersion infos - let g = - GlobalVersions - { _globalVersionsStdlib = globalVer - } - runReader g (checkConflicts >> m) +runGlobalVersions _txt m = do + checkConflicts >> m where -- Checks that no two different roots have the same PackageId - checkConflicts :: forall r'. (Members '[Reader GlobalVersions, PathResolver] r') => Sem r' () + checkConflicts :: forall r'. (Members '[PathResolver] r') => Sem r' () checkConflicts = do pkgs :: [PackageInfo] <- toList <$> getPackageInfos - reps <- findRepeatedOnM (packageLikePackageId . (^. packagePackage)) pkgs + let reps = findRepeatedOn (^. packageInfoPackageId) pkgs case nonEmpty reps of Just (rep :| _) -> errRep rep Nothing -> return () @@ -72,13 +66,10 @@ runGlobalVersions txt m = do <> "\n" <> Text.unlines (l ^.. to toList . each . packageRoot . to toFilePath) - getGlobalPkgVersion :: PackageInfo -> Sem r (Maybe SemVer) - getGlobalPkgVersion pkginfo = runFail $ do - PackageGlobalStdlib <- pure (pkginfo ^. packagePackage) - meta <- SHA256.digestFiles (packageFiles pkginfo) - pkg <- readGlobalPackage - -- NOTE that we ignore the meta in the version field of the Package.juvix file - return ((pkg ^. packageVersion) {_svMeta = Just meta}) +-- getGlobalPkgVersion :: (Members '[TaggedLock, Error JuvixError, EvalFileEff, Files] r) => Sem r SemVer +-- getGlobalPkgVersion = do +-- pkg <- readGlobalPackage +-- return (pkg ^. packageVersion) mkPackage :: forall r. @@ -99,6 +90,24 @@ findPackageJuvixFiles pkgRoot = map (fromJust . stripProperPrefix pkgRoot) <$> w newJuvixFiles :: [Path Abs File] newJuvixFiles = [cd f | f <- files, isJuvixOrJuvixMdFile f, not (isPackageFile f)] +mkPackageInfoPackageId :: (Members '[Files] r) => Path Abs Dir -> [Path Rel File] -> PackageLike -> Sem r PackageId +mkPackageInfoPackageId root pkgRelFiles pkgLike = do + let baseVersion = packageLikeVersion pkgLike + meta <- SHA256.digestFiles [root rFile | rFile <- pkgRelFiles] + return + PackageId + { _packageIdName = pkgLike ^. packageLikeName, + _packageIdVersion = baseVersion {_svMeta = Just meta} + } + where + packageLikeVersion :: PackageLike -> SemVer + packageLikeVersion = \case + PackageReal pkg -> pkg ^. packageVersion + PackageGlobal pkg -> pkg ^. packageVersion + PackageBase {} -> defaultVersion + PackageType {} -> defaultVersion + PackageDotJuvix {} -> defaultVersion + mkPackageInfo :: forall r. (Members '[TaggedLock, Files, Error JuvixError, Error DependencyError, Reader ResolverEnv, DependencyResolver] r) => @@ -122,7 +131,12 @@ mkPackageInfo mpackageEntry _packageRoot pkg = do : globalPackageBaseAbsDir : _packageRoot : depsPaths - return PackageInfo {..} + let pkgInfo0 = PackageInfo {_packageInfoPackageId = impossible, ..} + pkgId <- mkPackageInfoPackageId _packageRoot (toList _packageJuvixRelativeFiles) _packagePackage + return + pkgInfo0 + { _packageInfoPackageId = pkgId + } where pkgFile :: Path Abs File pkgFile = pkg ^. packageFile @@ -184,12 +198,14 @@ registerPackageBase = do packageBaseAbsDir <- globalPackageBaseRoot runReader packageBaseAbsDir updatePackageBaseFiles packageBaseRelFiles <- relFiles packageBaseAbsDir + _packageInfoPackageId <- mkPackageInfoPackageId packageBaseAbsDir (toList packageBaseRelFiles) PackageBase let pkgInfo = PackageInfo { _packageRoot = packageBaseAbsDir, _packageJuvixRelativeFiles = packageBaseRelFiles, _packagePackage = PackageBase, - _packageAvailableRoots = HashSet.singleton packageBaseAbsDir + _packageAvailableRoots = HashSet.singleton packageBaseAbsDir, + _packageInfoPackageId } dep = LockfileDependency @@ -315,7 +331,7 @@ addDependency' pkg me resolvedDependency = do selectPackageLockfile pkg $ do pkgInfo <- mkPackageInfo me (resolvedDependency ^. resolvedDependencyPath) pkg addPackageRelativeFiles pkgInfo - let packagePath = pkgInfo ^. packagePackage . packageLikeFile + let packagePath = packageLikeFile (pkgInfo ^. packagePackage) subDeps <- forM (pkgInfo ^. packagePackage . packageLikeDependencies) @@ -412,10 +428,9 @@ isModuleOrphan topJuvixPath = do && not (pathPackageBase `isProperPrefixOf` actualPath) ) -importNodePackageId :: (Members '[Reader GlobalVersions, PathResolver] r) => ImportNode -> Sem r PackageId -importNodePackageId n = do - pkg <- fromJust . (^. at (n ^. importNodePackageRoot)) <$> getPackageInfos - packageLikePackageId (pkg ^. packagePackage) +importNodePackageId :: (Members '[PathResolver] r) => ImportNode -> Sem r PackageId +importNodePackageId n = + (^?! at (n ^. importNodePackageRoot) . _Just . packageInfoPackageId) <$> getPackageInfos expectedPath' :: (Members '[Reader ResolverEnv, Files] r) => diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/GlobalVersions.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/GlobalVersions.hs deleted file mode 100644 index 7e52db4c31..0000000000 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/GlobalVersions.hs +++ /dev/null @@ -1,11 +0,0 @@ -module Juvix.Compiler.Pipeline.Loader.PathResolver.GlobalVersions where - -import Data.Versions -import Juvix.Prelude - -newtype GlobalVersions = GlobalVersions - { -- | This should be filled in iff one of the dependencies is the global standard library - _globalVersionsStdlib :: Maybe SemVer - } - -makeLenses ''GlobalVersions diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs index 3d4fc8ab38..69f7faad9d 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs @@ -1,7 +1,6 @@ module Juvix.Compiler.Pipeline.Loader.PathResolver.PackageInfo ( module Juvix.Compiler.Pipeline.Loader.PathResolver.PackageInfo, module Juvix.Compiler.Concrete.Translation.ImportScanner.Base, - module Juvix.Compiler.Pipeline.Loader.PathResolver.GlobalVersions, ) where @@ -9,14 +8,13 @@ import Data.HashSet qualified as HashSet import Data.Versions import Juvix.Compiler.Concrete.Translation.ImportScanner.Base import Juvix.Compiler.Pipeline.EntryPoint -import Juvix.Compiler.Pipeline.Loader.PathResolver.GlobalVersions import Juvix.Data.CodeAnn import Juvix.Extra.Strings qualified as Str import Juvix.Prelude data PackageLike = PackageReal Package - | PackageGlobalStdlib + | PackageGlobal Package | PackageBase | PackageType | PackageDotJuvix @@ -28,6 +26,7 @@ data PackageInfo = PackageInfo -- .juvix.md files. Note that it should not contain Package.juvix. _packageJuvixRelativeFiles :: HashSet (Path Rel File), _packageAvailableRoots :: HashSet (Path Abs Dir), + _packageInfoPackageId :: PackageId, _packagePackage :: PackageLike } deriving stock (Show) @@ -35,8 +34,11 @@ data PackageInfo = PackageInfo makeLenses ''PackageInfo makePrisms ''PackageLike -packageFiles :: PackageInfo -> [Path Abs File] -packageFiles k = [k ^. packageRoot f | f <- toList (k ^. packageJuvixRelativeFiles)] +packageInfoFilesHelper :: Path Abs Dir -> [Path Rel File] -> [Path Abs File] +packageInfoFilesHelper root files = [root f | f <- files] + +packageInfoFiles :: PackageInfo -> [Path Abs File] +packageInfoFiles k = packageInfoFilesHelper (k ^. packageRoot) (toList (k ^. packageJuvixRelativeFiles)) -- | Does *not* include Package.juvix packageJuvixFiles :: SimpleGetter PackageInfo (HashSet (Path Rel File)) @@ -46,57 +48,34 @@ packageJuvixFiles = keepJuvixFiles :: HashSet (Path Rel File) -> HashSet (Path Rel File) keepJuvixFiles = HashSet.filter isJuvixOrJuvixMdFile -packageLikePackageId :: (Members '[Reader GlobalVersions] r) => PackageLike -> Sem r PackageId -packageLikePackageId p = do - ver <- packageLikeVersion p - return - PackageId - { _packageIdName = p ^. packageLikeName, - _packageIdVersion = ver - } - packageLikeName :: SimpleGetter PackageLike Text packageLikeName = to $ \case PackageReal r -> r ^. packageName - PackageGlobalStdlib -> "global-stdlib" + PackageGlobal r -> r ^. packageName PackageBase -> Str.packageBase PackageType -> "package-type" PackageDotJuvix -> "package-dot-juvix" -packageLikeVersion :: (Members '[Reader GlobalVersions] r) => PackageLike -> Sem r SemVer -packageLikeVersion = \case - PackageReal pkg -> return (pkg ^. packageVersion) - PackageGlobalStdlib {} -> fromMaybe err <$> asks (^. globalVersionsStdlib) - PackageBase {} -> return defaultVersion - PackageType {} -> return defaultVersion - PackageDotJuvix {} -> return defaultVersion - where - err :: a - err = impossibleError "Asked the version of the global standard library but wasn't there" - -packageLikeNameAndVersion :: - (Members '[Reader GlobalVersions] r) => - PackageLike -> - Sem r (Doc CodeAnn) -packageLikeNameAndVersion n = do - v <- packageLikeVersion n - return - ( annotate AnnImportant (pretty (n ^. packageLikeName)) - <+> pretty (prettySemVer v) - ) +packageInfoNameAndVersion :: + PackageInfo -> + Doc CodeAnn +packageInfoNameAndVersion n = + let pid = n ^. packageInfoPackageId + in annotate AnnImportant (pretty (pid ^. packageIdName)) + <+> pretty (prettySemVer (pid ^. packageIdVersion)) packageLikeDependencies :: SimpleGetter PackageLike [Dependency] packageLikeDependencies = to $ \case PackageReal r -> r ^. packageDependencies - PackageGlobalStdlib -> [] + PackageGlobal r -> r ^. packageDependencies PackageBase -> [] PackageType -> [] PackageDotJuvix -> [] -packageLikeFile :: SimpleGetter PackageLike (Path Abs File) -packageLikeFile = to $ \case +packageLikeFile :: PackageLike -> Path Abs File +packageLikeFile = \case PackageReal r -> r ^. packageFile - PackageGlobalStdlib -> impossible + PackageGlobal r -> r ^. packageFile PackageBase -> impossible PackageType -> impossible PackageDotJuvix -> impossible diff --git a/src/Juvix/Compiler/Pipeline/ModuleInfoCache.hs b/src/Juvix/Compiler/Pipeline/ModuleInfoCache.hs index ccbfff39d2..0340a41868 100644 --- a/src/Juvix/Compiler/Pipeline/ModuleInfoCache.hs +++ b/src/Juvix/Compiler/Pipeline/ModuleInfoCache.hs @@ -28,7 +28,7 @@ entryIndexPath = fromMaybe err . (^. entryIxEntry . entryPointModulePath) err :: a err = error "unexpected: EntryIndex should always have a path" -mkEntryIndex :: (Members '[Reader GlobalVersions, PathResolver, Reader EntryPoint] r) => ImportNode -> Sem r EntryIndex +mkEntryIndex :: (Members '[PathResolver, Reader EntryPoint] r) => ImportNode -> Sem r EntryIndex mkEntryIndex node = do entry <- ask pkgId <- importNodePackageId node diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs index 9b71c9ba9c..c1f2e1ab06 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs @@ -5,6 +5,7 @@ import Juvix.Compiler.Concrete hiding (Symbol) import Juvix.Compiler.Core.Language import Juvix.Compiler.Pipeline.EntryPoint import Juvix.Compiler.Pipeline.Loader.PathResolver +import Juvix.Compiler.Pipeline.Package import Juvix.Compiler.Pipeline.Package.Loader.EvalEff import Juvix.Extra.PackageFiles import Juvix.Extra.Paths @@ -116,6 +117,7 @@ runPackagePathResolver rootPath sem = do let root = ds ^. rootInfoArgGlobalStdlibDir jufiles <- findPackageJuvixFiles root let rfiles = hashSet jufiles + pkg <- readGlobalPackage return PackageInfo { _packageRoot = root, @@ -125,7 +127,7 @@ runPackagePathResolver rootPath sem = do [ ds ^. rootInfoArgPackageBaseDir, ds ^. rootInfoArgGlobalStdlibDir ], - _packagePackage = PackageGlobalStdlib + _packagePackage = PackageGlobal pkg } mkPackageDotJuvix :: Sem r PackageInfo diff --git a/src/Juvix/Compiler/Pipeline/Repl.hs b/src/Juvix/Compiler/Pipeline/Repl.hs index 30c352bad3..558c82d8fc 100644 --- a/src/Juvix/Compiler/Pipeline/Repl.hs +++ b/src/Juvix/Compiler/Pipeline/Repl.hs @@ -118,7 +118,7 @@ compileExpression p = >>= fromInternalExpression registerImport :: - (Members '[TaggedLock, Reader GlobalVersions, Error JuvixError, State Artifacts, Reader EntryPoint, Files, GitClone, PathResolver, ModuleInfoCache] r) => + (Members '[TaggedLock, Error JuvixError, State Artifacts, Reader EntryPoint, Files, GitClone, PathResolver, ModuleInfoCache] r) => Import 'Parsed -> Sem r () registerImport i = do diff --git a/src/Juvix/Compiler/Pipeline/Run.hs b/src/Juvix/Compiler/Pipeline/Run.hs index 8ae9096896..ba418bfd14 100644 --- a/src/Juvix/Compiler/Pipeline/Run.hs +++ b/src/Juvix/Compiler/Pipeline/Run.hs @@ -148,7 +148,6 @@ evalModuleInfoCacheHelper :: Reader ImportScanStrategy, Reader NumThreads, Reader PipelineOptions, - Reader GlobalVersions, Logger, Files ] diff --git a/src/Parallel/ProgressLog.hs b/src/Parallel/ProgressLog.hs index 5fbd415043..45731ee607 100644 --- a/src/Parallel/ProgressLog.hs +++ b/src/Parallel/ProgressLog.hs @@ -68,7 +68,6 @@ runProgressLog :: '[ PathResolver, Reader ImportTree, Reader PipelineOptions, - Reader GlobalVersions, Logger, Concurrent ] @@ -92,7 +91,7 @@ runProgressLog m = do runProgressLogOptions :: forall r a. - (Members '[Logger, Concurrent, Reader GlobalVersions] r) => + (Members '[Logger, Concurrent] r) => ProgressLogOptions -> Sem (ProgressLog ': r) a -> Sem r a @@ -105,8 +104,8 @@ runProgressLogOptions opts m = do wait logHandler return x where - getPackageTag :: Path Abs Dir -> Sem r (Doc CodeAnn) - getPackageTag pkgRoot = packageLikeNameAndVersion (opts ^?! progressLogOptionsPackages . at pkgRoot . _Just . packagePackage) + packageTag :: Path Abs Dir -> Doc CodeAnn + packageTag pkgRoot = packageInfoNameAndVersion (opts ^?! progressLogOptionsPackages . at pkgRoot . _Just) tree :: ImportTree tree = opts ^. progressLogOptionsImportTree @@ -162,7 +161,7 @@ runProgressLogOptions opts m = do handler :: TVar ProgressLogState -> LogQueue -> EffectHandlerFO ProgressLog r handler st logs = \case ProgressLog i -> do - tag <- getPackageTag fromPackage + let tag = packageTag fromPackage atomically $ do n <- getNextNumber let k From 27afe0a8650d7b11ceacc8b266c6be5695b17986 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 2 Dec 2024 15:25:57 +0100 Subject: [PATCH 10/25] packageId with hash --- .../Compiler/Core/Data/InfoTable/Base.hs | 1 - .../Compiler/Pipeline/Loader/PathResolver.hs | 1 + .../Pipeline/Package/Loader/PathResolver.hs | 25 ++++++++++++++----- 3 files changed, 20 insertions(+), 7 deletions(-) diff --git a/src/Juvix/Compiler/Core/Data/InfoTable/Base.hs b/src/Juvix/Compiler/Core/Data/InfoTable/Base.hs index 9773f8ae08..83cdc8a173 100644 --- a/src/Juvix/Compiler/Core/Data/InfoTable/Base.hs +++ b/src/Juvix/Compiler/Core/Data/InfoTable/Base.hs @@ -2,7 +2,6 @@ module Juvix.Compiler.Core.Data.InfoTable.Base where import Juvix.Compiler.Concrete.Data.Builtins import Juvix.Compiler.Core.Language.Base -import Juvix.Extra.Serialize data InfoTable' n = InfoTable { _identContext :: HashMap Symbol n, diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs index aa78c90ed4..edb7f33b63 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs @@ -12,6 +12,7 @@ module Juvix.Compiler.Pipeline.Loader.PathResolver findPackageJuvixFiles, runGlobalVersions, importNodePackageId, + mkPackageInfoPackageId, ) where diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs index c1f2e1ab06..e2bbe53b68 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs @@ -87,23 +87,30 @@ runPackagePathResolver rootPath sem = do mkPkgBase :: Sem r PackageInfo mkPkgBase = do let rfiles = fs ^. rootInfoFilesPackageBase + root = ds ^. rootInfoArgPackageBaseDir + pkgTy = PackageBase + pkgId <- mkPackageInfoPackageId root (toList rfiles) pkgTy return PackageInfo - { _packageRoot = ds ^. rootInfoArgPackageBaseDir, + { _packageRoot = root, _packageAvailableRoots = hashSet [ds ^. rootInfoArgPackageBaseDir], _packageJuvixRelativeFiles = rfiles, - _packagePackage = PackageBase + _packagePackage = pkgTy, + _packageInfoPackageId = pkgId } mkPkgPackageType :: Sem r PackageInfo mkPkgPackageType = do let rfiles = fs ^. rootInfoFilesPackage root = ds ^. rootInfoArgPackageDir + pkgTy = PackageType + pkgId <- mkPackageInfoPackageId root (toList rfiles) pkgTy return PackageInfo { _packageRoot = root, _packageJuvixRelativeFiles = rfiles, - _packagePackage = PackageType, + _packagePackage = pkgTy, + _packageInfoPackageId = pkgId, _packageAvailableRoots = hashSet [ ds ^. rootInfoArgPackageDir, @@ -116,23 +123,28 @@ runPackagePathResolver rootPath sem = do mkPkgGlobalStdlib = do let root = ds ^. rootInfoArgGlobalStdlibDir jufiles <- findPackageJuvixFiles root - let rfiles = hashSet jufiles pkg <- readGlobalPackage + let rfiles = hashSet jufiles + pkgTy = PackageGlobal pkg + pkgId <- mkPackageInfoPackageId root (toList rfiles) pkgTy return PackageInfo { _packageRoot = root, _packageJuvixRelativeFiles = rfiles, + _packageInfoPackageId = pkgId, _packageAvailableRoots = hashSet [ ds ^. rootInfoArgPackageBaseDir, ds ^. rootInfoArgGlobalStdlibDir ], - _packagePackage = PackageGlobal pkg + _packagePackage = pkgTy } mkPackageDotJuvix :: Sem r PackageInfo mkPackageDotJuvix = do let rfiles = hashSet [packageFilePath] + pkgTy = PackageDotJuvix + pkgId <- mkPackageInfoPackageId rootPath (toList rfiles) pkgTy return PackageInfo { _packageRoot = rootPath, @@ -144,7 +156,8 @@ runPackagePathResolver rootPath sem = do ds ^. rootInfoArgGlobalStdlibDir, rootPath ], - _packagePackage = PackageDotJuvix + _packagePackage = pkgTy, + _packageInfoPackageId = pkgId } rootInfoDirs :: Sem r RootInfoDirs From 05531e6801d6cec7e38017cfd0985dbf278b054c Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 2 Dec 2024 16:14:08 +0100 Subject: [PATCH 11/25] remove Package from global stdlib --- .../Compiler/Pipeline/Loader/PathResolver.hs | 28 +++++++++---------- .../Loader/PathResolver/PackageInfo.hs | 8 +++--- src/Juvix/Compiler/Pipeline/Package.hs | 1 + .../Pipeline/Package/Loader/PathResolver.hs | 12 ++++---- 4 files changed, 24 insertions(+), 25 deletions(-) diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs index edb7f33b63..80862abab4 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs @@ -19,6 +19,7 @@ where import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet import Data.Text qualified as Text +import Data.Versions qualified as Ver import Juvix.Compiler.Concrete.Data.Name import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error import Juvix.Compiler.Concrete.Translation.ImportScanner @@ -94,17 +95,17 @@ findPackageJuvixFiles pkgRoot = map (fromJust . stripProperPrefix pkgRoot) <$> w mkPackageInfoPackageId :: (Members '[Files] r) => Path Abs Dir -> [Path Rel File] -> PackageLike -> Sem r PackageId mkPackageInfoPackageId root pkgRelFiles pkgLike = do let baseVersion = packageLikeVersion pkgLike - meta <- SHA256.digestFiles [root rFile | rFile <- pkgRelFiles] + filesHash <- SHA256.digestFiles [root rFile | rFile <- pkgRelFiles] return PackageId { _packageIdName = pkgLike ^. packageLikeName, - _packageIdVersion = baseVersion {_svMeta = Just meta} + _packageIdVersion = baseVersion {_svPreRel = Just (Ver.Release (pure (Ver.Alphanum filesHash)))} } where packageLikeVersion :: PackageLike -> SemVer packageLikeVersion = \case PackageReal pkg -> pkg ^. packageVersion - PackageGlobal pkg -> pkg ^. packageVersion + PackageStdlibInGlobalPackage -> defaultVersion PackageBase {} -> defaultVersion PackageType {} -> defaultVersion PackageDotJuvix {} -> defaultVersion @@ -176,17 +177,16 @@ mkPackageInfo mpackageEntry _packageRoot pkg = do checkDep d = unless (mkName d `HashSet.member` lockfileDepNames) - ( throw - DependencyError - { _dependencyErrorPackageFile = pkgFile, - _dependencyErrorCause = - MissingLockfileDependencyError - MissingLockfileDependency - { _missingLockfileDependencyDependency = d, - _missingLockfileDependencyPath = lf ^. lockfileInfoPath - } - } - ) + $ throw + DependencyError + { _dependencyErrorPackageFile = pkgFile, + _dependencyErrorCause = + MissingLockfileDependencyError + MissingLockfileDependency + { _missingLockfileDependencyDependency = d, + _missingLockfileDependencyPath = lf ^. lockfileInfoPath + } + } lookupCachedDependency :: (Members '[State ResolverState, Reader ResolverEnv, Files, DependencyResolver] r) => Path Abs Dir -> Sem r (Maybe LockfileDependency) lookupCachedDependency p = fmap (^. resolverCacheItemDependency) . HashMap.lookup p <$> gets (^. resolverCache) diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs index 69f7faad9d..15681c7f8f 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs @@ -14,7 +14,7 @@ import Juvix.Prelude data PackageLike = PackageReal Package - | PackageGlobal Package + | PackageStdlibInGlobalPackage | PackageBase | PackageType | PackageDotJuvix @@ -51,7 +51,7 @@ keepJuvixFiles = HashSet.filter isJuvixOrJuvixMdFile packageLikeName :: SimpleGetter PackageLike Text packageLikeName = to $ \case PackageReal r -> r ^. packageName - PackageGlobal r -> r ^. packageName + PackageStdlibInGlobalPackage {} -> "global-stdlib" PackageBase -> Str.packageBase PackageType -> "package-type" PackageDotJuvix -> "package-dot-juvix" @@ -67,7 +67,7 @@ packageInfoNameAndVersion n = packageLikeDependencies :: SimpleGetter PackageLike [Dependency] packageLikeDependencies = to $ \case PackageReal r -> r ^. packageDependencies - PackageGlobal r -> r ^. packageDependencies + PackageStdlibInGlobalPackage {} -> impossible PackageBase -> [] PackageType -> [] PackageDotJuvix -> [] @@ -75,7 +75,7 @@ packageLikeDependencies = to $ \case packageLikeFile :: PackageLike -> Path Abs File packageLikeFile = \case PackageReal r -> r ^. packageFile - PackageGlobal r -> r ^. packageFile + PackageStdlibInGlobalPackage {} -> impossible PackageBase -> impossible PackageType -> impossible PackageDotJuvix -> impossible diff --git a/src/Juvix/Compiler/Pipeline/Package.hs b/src/Juvix/Compiler/Pipeline/Package.hs index e343048938..6350eb1d4a 100644 --- a/src/Juvix/Compiler/Pipeline/Package.hs +++ b/src/Juvix/Compiler/Pipeline/Package.hs @@ -133,6 +133,7 @@ ensureGlobalPackage = do readGlobalPackage :: (Members '[TaggedLock, Error JuvixError, EvalFileEff, Files] r) => Sem r Package readGlobalPackage = do + traceM "readGlobalPackage" packagePath <- ensureGlobalPackage readPackage (parent packagePath) DefaultBuildDir diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs index e2bbe53b68..2aa4e41518 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs @@ -5,7 +5,6 @@ import Juvix.Compiler.Concrete hiding (Symbol) import Juvix.Compiler.Core.Language import Juvix.Compiler.Pipeline.EntryPoint import Juvix.Compiler.Pipeline.Loader.PathResolver -import Juvix.Compiler.Pipeline.Package import Juvix.Compiler.Pipeline.Package.Loader.EvalEff import Juvix.Extra.PackageFiles import Juvix.Extra.Paths @@ -74,12 +73,12 @@ runPackagePathResolver rootPath sem = do Sem r (HashMap (Path Abs Dir) PackageInfo) mkPackageInfos ds fs = do pkgBase <- mkPkgBase - gstdlib <- mkPkgGlobalStdlib + globalPkg <- mkPkgGlobal pkgDotJuvix <- mkPackageDotJuvix pkgType <- mkPkgPackageType return . hashMap - $ mkAssoc <$> [pkgBase, pkgType, gstdlib, pkgDotJuvix] + $ mkAssoc <$> [pkgBase, pkgType, globalPkg, pkgDotJuvix] where mkAssoc :: PackageInfo -> (Path Abs Dir, PackageInfo) mkAssoc pkg = (pkg ^. packageRoot, pkg) @@ -119,13 +118,12 @@ runPackagePathResolver rootPath sem = do ] } - mkPkgGlobalStdlib :: Sem r PackageInfo - mkPkgGlobalStdlib = do + mkPkgGlobal :: Sem r PackageInfo + mkPkgGlobal = do let root = ds ^. rootInfoArgGlobalStdlibDir jufiles <- findPackageJuvixFiles root - pkg <- readGlobalPackage let rfiles = hashSet jufiles - pkgTy = PackageGlobal pkg + pkgTy = PackageStdlibInGlobalPackage pkgId <- mkPackageInfoPackageId root (toList rfiles) pkgTy return PackageInfo From b9c9a37347f50040b46b7af8b3d94582730d7653 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 2 Dec 2024 16:42:22 +0100 Subject: [PATCH 12/25] fill pre-release with hash only when it is not there --- .../Compiler/Pipeline/Loader/PathResolver.hs | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs index 80862abab4..1fd9564a97 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs @@ -68,11 +68,6 @@ runGlobalVersions _txt m = do <> "\n" <> Text.unlines (l ^.. to toList . each . packageRoot . to toFilePath) --- getGlobalPkgVersion :: (Members '[TaggedLock, Error JuvixError, EvalFileEff, Files] r) => Sem r SemVer --- getGlobalPkgVersion = do --- pkg <- readGlobalPackage --- return (pkg ^. packageVersion) - mkPackage :: forall r. (Members '[Files, Error JuvixError, Reader ResolverEnv, DependencyResolver, EvalFileEff] r) => @@ -92,14 +87,20 @@ findPackageJuvixFiles pkgRoot = map (fromJust . stripProperPrefix pkgRoot) <$> w newJuvixFiles :: [Path Abs File] newJuvixFiles = [cd f | f <- files, isJuvixOrJuvixMdFile f, not (isPackageFile f)] +-- | If the file has a pre-release tag we keep it as it is. Otherwise we hash +-- all juvix files in the package. mkPackageInfoPackageId :: (Members '[Files] r) => Path Abs Dir -> [Path Rel File] -> PackageLike -> Sem r PackageId mkPackageInfoPackageId root pkgRelFiles pkgLike = do let baseVersion = packageLikeVersion pkgLike - filesHash <- SHA256.digestFiles [root rFile | rFile <- pkgRelFiles] + version <- case Ver._svPreRel baseVersion of + Nothing -> do + filesHash <- SHA256.digestFiles [root rFile | rFile <- pkgRelFiles] + return baseVersion {_svPreRel = Just (Ver.Release (pure (Ver.Alphanum filesHash)))} + Just {} -> return baseVersion return PackageId { _packageIdName = pkgLike ^. packageLikeName, - _packageIdVersion = baseVersion {_svPreRel = Just (Ver.Release (pure (Ver.Alphanum filesHash)))} + _packageIdVersion = version } where packageLikeVersion :: PackageLike -> SemVer From 90d98cfb6f7a76c89e7c367641ec3d6ba059e9d0 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 2 Dec 2024 16:48:42 +0100 Subject: [PATCH 13/25] clean --- .../Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs | 5 +---- src/Juvix/Compiler/Pipeline/Package.hs | 1 - src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs | 6 +++--- 3 files changed, 4 insertions(+), 8 deletions(-) diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs index 15681c7f8f..9903c9cc0c 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/PackageInfo.hs @@ -34,11 +34,8 @@ data PackageInfo = PackageInfo makeLenses ''PackageInfo makePrisms ''PackageLike -packageInfoFilesHelper :: Path Abs Dir -> [Path Rel File] -> [Path Abs File] -packageInfoFilesHelper root files = [root f | f <- files] - packageInfoFiles :: PackageInfo -> [Path Abs File] -packageInfoFiles k = packageInfoFilesHelper (k ^. packageRoot) (toList (k ^. packageJuvixRelativeFiles)) +packageInfoFiles k = [k ^. packageRoot f | f <- (toList (k ^. packageJuvixRelativeFiles))] -- | Does *not* include Package.juvix packageJuvixFiles :: SimpleGetter PackageInfo (HashSet (Path Rel File)) diff --git a/src/Juvix/Compiler/Pipeline/Package.hs b/src/Juvix/Compiler/Pipeline/Package.hs index 6350eb1d4a..e343048938 100644 --- a/src/Juvix/Compiler/Pipeline/Package.hs +++ b/src/Juvix/Compiler/Pipeline/Package.hs @@ -133,7 +133,6 @@ ensureGlobalPackage = do readGlobalPackage :: (Members '[TaggedLock, Error JuvixError, EvalFileEff, Files] r) => Sem r Package readGlobalPackage = do - traceM "readGlobalPackage" packagePath <- ensureGlobalPackage readPackage (parent packagePath) DefaultBuildDir diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs index 2aa4e41518..47d302694f 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs @@ -73,7 +73,7 @@ runPackagePathResolver rootPath sem = do Sem r (HashMap (Path Abs Dir) PackageInfo) mkPackageInfos ds fs = do pkgBase <- mkPkgBase - globalPkg <- mkPkgGlobal + globalPkg <- mkPkgStdlibInGlobal pkgDotJuvix <- mkPackageDotJuvix pkgType <- mkPkgPackageType return @@ -118,8 +118,8 @@ runPackagePathResolver rootPath sem = do ] } - mkPkgGlobal :: Sem r PackageInfo - mkPkgGlobal = do + mkPkgStdlibInGlobal :: Sem r PackageInfo + mkPkgStdlibInGlobal = do let root = ds ^. rootInfoArgGlobalStdlibDir jufiles <- findPackageJuvixFiles root let rfiles = hashSet jufiles From e26aa4671e2cb93cb2996c666108cce8942ec341 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 2 Dec 2024 18:44:26 +0100 Subject: [PATCH 14/25] add test --- src/Juvix/Compiler/Concrete/Data/Name.hs | 6 ++- .../Compiler/Pipeline/Loader/PathResolver.hs | 37 +------------------ .../Pipeline/Loader/PathResolver/Error.hs | 23 ++++++++++++ .../Pipeline/Package/Loader/PathResolver.hs | 20 +++++++++- src/Juvix/Compiler/Pipeline/Repl.hs | 1 - src/Juvix/Compiler/Pipeline/Run.hs | 2 - src/Juvix/Data/CodeAnn.hs | 13 ++++++- src/Juvix/Data/Loc.hs | 3 ++ src/Juvix/Data/NameKind.hs | 2 +- src/Juvix/Prelude/Base.hs | 7 +--- test/Resolver/Negative.hs | 7 ++++ tests/negative/AmbiguousPackageId/Main.juvix | 1 + .../negative/AmbiguousPackageId/Package.juvix | 9 +++++ .../AmbiguousPackageId/dep1/Package.juvix | 9 +++++ .../AmbiguousPackageId/dep1/main.juvix | 1 + .../AmbiguousPackageId/dep2/Package.juvix | 9 +++++ .../AmbiguousPackageId/dep2/main.juvix | 1 + 17 files changed, 103 insertions(+), 48 deletions(-) create mode 100644 tests/negative/AmbiguousPackageId/Main.juvix create mode 100644 tests/negative/AmbiguousPackageId/Package.juvix create mode 100644 tests/negative/AmbiguousPackageId/dep1/Package.juvix create mode 100644 tests/negative/AmbiguousPackageId/dep1/main.juvix create mode 100644 tests/negative/AmbiguousPackageId/dep2/Package.juvix create mode 100644 tests/negative/AmbiguousPackageId/dep2/main.juvix diff --git a/src/Juvix/Compiler/Concrete/Data/Name.hs b/src/Juvix/Compiler/Concrete/Data/Name.hs index 98346fc14b..8b9f4c6d88 100644 --- a/src/Juvix/Compiler/Concrete/Data/Name.hs +++ b/src/Juvix/Compiler/Concrete/Data/Name.hs @@ -1,8 +1,12 @@ module Juvix.Compiler.Concrete.Data.Name where import Data.List.NonEmpty.Extra qualified as NonEmpty +import Juvix.Data.Fixity +import Juvix.Data.Loc +import Juvix.Data.TopModulePathKey +import Juvix.Data.WithLoc import Juvix.Extra.Serialize -import Juvix.Prelude +import Juvix.Prelude.Base import Juvix.Prelude.Pretty as Pretty type Symbol = WithLoc Text diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs index 1fd9564a97..5ec4d4867a 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs @@ -10,7 +10,6 @@ module Juvix.Compiler.Pipeline.Loader.PathResolver runPathResolverPipe', evalPathResolverPipe, findPackageJuvixFiles, - runGlobalVersions, importNodePackageId, mkPackageInfoPackageId, ) @@ -18,7 +17,6 @@ where import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet -import Data.Text qualified as Text import Data.Versions qualified as Ver import Juvix.Compiler.Concrete.Data.Name import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error @@ -41,33 +39,6 @@ import Juvix.Extra.Paths import Juvix.Extra.Stdlib (ensureStdlib) import Juvix.Prelude --- | TODO rename and move somewhere else -runGlobalVersions :: - forall r a. - (Members '[PathResolver, Files, TaggedLock, Error JuvixError, EvalFileEff] r) => - Text -> - Sem r a -> - Sem r a -runGlobalVersions _txt m = do - checkConflicts >> m - where - -- Checks that no two different roots have the same PackageId - checkConflicts :: forall r'. (Members '[PathResolver] r') => Sem r' () - checkConflicts = do - pkgs :: [PackageInfo] <- toList <$> getPackageInfos - let reps = findRepeatedOn (^. packageInfoPackageId) pkgs - case nonEmpty reps of - Just (rep :| _) -> errRep rep - Nothing -> return () - where - errRep :: (NonEmpty PackageInfo, PackageId) -> Sem r' () - errRep (l, pid) = - error $ - "Non-unique package id: " - <> show pid - <> "\n" - <> Text.unlines (l ^.. to toList . each . packageRoot . to toFilePath) - mkPackage :: forall r. (Members '[Files, Error JuvixError, Reader ResolverEnv, DependencyResolver, EvalFileEff] r) => @@ -134,12 +105,8 @@ mkPackageInfo mpackageEntry _packageRoot pkg = do : globalPackageBaseAbsDir : _packageRoot : depsPaths - let pkgInfo0 = PackageInfo {_packageInfoPackageId = impossible, ..} - pkgId <- mkPackageInfoPackageId _packageRoot (toList _packageJuvixRelativeFiles) _packagePackage - return - pkgInfo0 - { _packageInfoPackageId = pkgId - } + _packageInfoPackageId <- mkPackageInfoPackageId _packageRoot (toList _packageJuvixRelativeFiles) _packagePackage + return PackageInfo {..} where pkgFile :: Path Abs File pkgFile = pkg ^. packageFile diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs index 6d84e401b8..eda55582fe 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs @@ -5,6 +5,7 @@ import Juvix.Compiler.Pipeline.Loader.PathResolver.PackageInfo import Juvix.Compiler.Pipeline.Package.Base import Juvix.Data.CodeAnn import Juvix.Data.Effect.Git +import Juvix.Extra.Paths.Base import Juvix.Prelude data DependencyErrorGit = DependencyErrorGit @@ -93,6 +94,7 @@ data PathResolverError = ErrDependencyConflict DependencyConflict | ErrMissingModule MissingModule | ErrPackageInvalidImport PackageInvalidImport + | ErrAmbiguousPackageId AmbiguousPackageId deriving stock (Show) instance ToGenericError PathResolverError where @@ -114,12 +116,14 @@ instance HasLoc PathResolverError where getLoc _missingModule ErrPackageInvalidImport PackageInvalidImport {..} -> getLoc _packageInvalidImport + ErrAmbiguousPackageId a -> getLoc a instance PrettyCodeAnn PathResolverError where ppCodeAnn = \case ErrDependencyConflict e -> ppCodeAnn e ErrMissingModule e -> ppCodeAnn e ErrPackageInvalidImport e -> ppCodeAnn e + ErrAmbiguousPackageId e -> ppCodeAnn e data DependencyConflict = DependencyConflict { _conflictPackages :: NonEmpty PackageInfo, @@ -184,3 +188,22 @@ instance PrettyCodeAnn PackageInvalidImport where <+> "cannot be imported by the Package file." <> line <> "Package files may only import modules from the Juvix standard library, Juvix.Builtin modules, or from the PackageDescription module." + +data AmbiguousPackageId = AmbiguousPackageId + { _ambiguousPackageId :: PackageId, + _ambiguousPackageIdPackages :: NonEmpty PackageInfo + } + deriving stock (Show) + +instance HasLoc AmbiguousPackageId where + getLoc AmbiguousPackageId {..} = intervalFromFile ((head _ambiguousPackageIdPackages) ^. packageRoot packageFilePath) + +instance PrettyCodeAnn AmbiguousPackageId where + ppCodeAnn AmbiguousPackageId {..} = do + "Ambiguous package id:" + <> line + <> ppCodeAnn _ambiguousPackageId + <> line + <> "The above package id is the same for the following packages" + <> line + <> itemize [] diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs index 47d302694f..0981c5cac8 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs @@ -30,7 +30,7 @@ makeLenses ''RootInfoFiles -- package and global standard library (currently under global-package/.juvix-build) runPackagePathResolver :: forall r a. - (Members '[TaggedLock, Error JuvixError, Files, EvalFileEff] r) => + (Members '[Error JuvixError, TaggedLock, Files, EvalFileEff] r) => Path Abs Dir -> Sem (PathResolver ': r) a -> Sem r a @@ -40,6 +40,7 @@ runPackagePathResolver rootPath sem = do fs <- rootInfoFiles ds let mkRootInfo' :: Path Rel File -> Maybe RootInfo = mkRootInfo ds fs packageInfos <- mkPackageInfos ds fs + checkConflicts (toList packageInfos) (`interpretH` sem) $ \localEnv -> \case SupportsParallel -> return False ResolverRoot -> return rootPath @@ -67,6 +68,23 @@ runPackagePathResolver rootPath sem = do -- the _root' is not used because ResolvePath does not depend on it runTSimpleEff localEnv m where + checkConflicts :: forall r'. (Members '[Error JuvixError] r') => [PackageInfo] -> Sem r' () + checkConflicts pkgs = do + let reps = findRepeatedOn (^. packageInfoPackageId) pkgs + case nonEmpty reps of + Just (rep :| _) -> errRep rep + Nothing -> return () + where + errRep :: (NonEmpty PackageInfo, PackageId) -> Sem r' () + errRep (l, pid) = + throw + . JuvixError + $ ErrAmbiguousPackageId + AmbiguousPackageId + { _ambiguousPackageId = pid, + _ambiguousPackageIdPackages = l + } + mkPackageInfos :: RootInfoDirs -> RootInfoFiles -> diff --git a/src/Juvix/Compiler/Pipeline/Repl.hs b/src/Juvix/Compiler/Pipeline/Repl.hs index 558c82d8fc..493930e2be 100644 --- a/src/Juvix/Compiler/Pipeline/Repl.hs +++ b/src/Juvix/Compiler/Pipeline/Repl.hs @@ -180,7 +180,6 @@ compileReplInputIO fp txt = do . runTopModuleNameChecker . runReader defaultImportScanStrategy . withImportTree (Just fp) - . runGlobalVersions "repl" . evalModuleInfoCacheHelper $ do p <- parseReplInput fp txt diff --git a/src/Juvix/Compiler/Pipeline/Run.hs b/src/Juvix/Compiler/Pipeline/Run.hs index ba418bfd14..aad458a24e 100644 --- a/src/Juvix/Compiler/Pipeline/Run.hs +++ b/src/Juvix/Compiler/Pipeline/Run.hs @@ -126,7 +126,6 @@ runIOEitherPipeline' entry a = do . runDependencyResolver . runReader (opts ^. pipelineDependenciesConfig) . runPathResolverInput - . runGlobalVersions "runIOEitherPipeline'" . runTopModuleNameChecker . runReader (opts ^. pipelineImportStrategy) . withImportTree (entry ^. entryPointModulePath) @@ -235,7 +234,6 @@ runReplPipelineIOEither' lockMode entry = do . runTopModuleNameChecker . runReader defaultImportScanStrategy . withImportTree (entry ^. entryPointModulePath) - . runGlobalVersions "runReplPipeline" . evalModuleInfoCacheHelper $ processFileToStoredCore entry return $ case eith of diff --git a/src/Juvix/Data/CodeAnn.hs b/src/Juvix/Data/CodeAnn.hs index f61b6680c3..63f8fa7cb3 100644 --- a/src/Juvix/Data/CodeAnn.hs +++ b/src/Juvix/Data/CodeAnn.hs @@ -5,11 +5,17 @@ module Juvix.Data.CodeAnn ) where +import Data.Versions (prettySemVer) import Juvix.Compiler.Concrete.Data.Name +import Juvix.Data.Error.GenericError +import Juvix.Data.IsImplicit import Juvix.Data.Keyword +import Juvix.Data.NameId import Juvix.Data.NameKind +import Juvix.Data.PackageId +import Juvix.Data.WithLoc import Juvix.Extra.Strings qualified as Str -import Juvix.Prelude +import Juvix.Prelude.Base import Juvix.Prelude.Pretty hiding (braces, brackets, group, list, parens) import Prettyprinter.Render.Terminal (Color (..), bold, colorDull) @@ -44,6 +50,11 @@ instance HasNameKind CodeAnnReference where getNameKind = (^. codeAnnReferenceNameKindPretty) getNameKindPretty = (^. codeAnnReferenceNameKindPretty) +instance PrettyCodeAnn PackageId where + ppCodeAnn pid = + annotate AnnImportant (pretty (pid ^. packageIdName)) + <+> pretty (prettySemVer (pid ^. packageIdVersion)) + instance HasNameKindAnn Ann where annNameKind = AnnKind diff --git a/src/Juvix/Data/Loc.hs b/src/Juvix/Data/Loc.hs index e655f564e9..ad9d527dbf 100644 --- a/src/Juvix/Data/Loc.hs +++ b/src/Juvix/Data/Loc.hs @@ -117,6 +117,9 @@ makeLenses ''FileLoc makeLenses ''Loc makeLenses ''Pos +intervalFromFile :: Path Abs File -> Interval +intervalFromFile = singletonInterval . mkInitialLoc + singletonInterval :: Loc -> Interval singletonInterval l = Interval diff --git a/src/Juvix/Data/NameKind.hs b/src/Juvix/Data/NameKind.hs index f2bd976169..88f05a4b61 100644 --- a/src/Juvix/Data/NameKind.hs +++ b/src/Juvix/Data/NameKind.hs @@ -1,7 +1,7 @@ module Juvix.Data.NameKind where import Juvix.Extra.Serialize -import Juvix.Prelude +import Juvix.Prelude.Base import Juvix.Prelude.Pretty import Prettyprinter.Render.Terminal diff --git a/src/Juvix/Prelude/Base.hs b/src/Juvix/Prelude/Base.hs index 0a07e0d544..944e06baa3 100644 --- a/src/Juvix/Prelude/Base.hs +++ b/src/Juvix/Prelude/Base.hs @@ -43,12 +43,7 @@ findRepeatedOn f = runIdentity . findRepeatedOnM (return . f) -- | Returns the repeated elements findRepeated :: forall a. (Ord a) => [a] -> [a] -findRepeated = mapMaybe rep . groupSortOn id - where - rep :: NonEmpty a -> Maybe a - rep = \case - (a :| _ : _) -> Just a - _ -> Nothing +findRepeated = map (head . fst) . findRepeatedOn id allDifferent :: forall a. (Ord a) => [a] -> Bool allDifferent = null . findRepeated diff --git a/test/Resolver/Negative.hs b/test/Resolver/Negative.hs index 93f7b3a1be..6bfc057221 100644 --- a/test/Resolver/Negative.hs +++ b/test/Resolver/Negative.hs @@ -69,5 +69,12 @@ resolverErrorTests = $ \case ErrMissingModule MissingModule {} -> Nothing + _ -> wrongError, + negTest + "Depend on two packages with the same package id" + $(mkRelDir "AmbiguousPackageId") + $(mkRelFile "Main.juvix") + $ \case + ErrAmbiguousPackageId {} -> Nothing _ -> wrongError ] diff --git a/tests/negative/AmbiguousPackageId/Main.juvix b/tests/negative/AmbiguousPackageId/Main.juvix new file mode 100644 index 0000000000..fef5380749 --- /dev/null +++ b/tests/negative/AmbiguousPackageId/Main.juvix @@ -0,0 +1 @@ +module Main; diff --git a/tests/negative/AmbiguousPackageId/Package.juvix b/tests/negative/AmbiguousPackageId/Package.juvix new file mode 100644 index 0000000000..ade67217d3 --- /dev/null +++ b/tests/negative/AmbiguousPackageId/Package.juvix @@ -0,0 +1,9 @@ +module Package; + +import PackageDescription.V2 open; + +package : Package := + defaultPackage@?{ + name := "ambiguouspackageid"; + dependencies := [path "dep1"; path "dep2"]; + }; diff --git a/tests/negative/AmbiguousPackageId/dep1/Package.juvix b/tests/negative/AmbiguousPackageId/dep1/Package.juvix new file mode 100644 index 0000000000..8fc198954c --- /dev/null +++ b/tests/negative/AmbiguousPackageId/dep1/Package.juvix @@ -0,0 +1,9 @@ +module Package; + +import PackageDescription.V2 open; + +package : Package := + defaultPackage@?{ + name := "dep"; + dependencies := []; + }; diff --git a/tests/negative/AmbiguousPackageId/dep1/main.juvix b/tests/negative/AmbiguousPackageId/dep1/main.juvix new file mode 100644 index 0000000000..8bffabe306 --- /dev/null +++ b/tests/negative/AmbiguousPackageId/dep1/main.juvix @@ -0,0 +1 @@ +module main; diff --git a/tests/negative/AmbiguousPackageId/dep2/Package.juvix b/tests/negative/AmbiguousPackageId/dep2/Package.juvix new file mode 100644 index 0000000000..8fc198954c --- /dev/null +++ b/tests/negative/AmbiguousPackageId/dep2/Package.juvix @@ -0,0 +1,9 @@ +module Package; + +import PackageDescription.V2 open; + +package : Package := + defaultPackage@?{ + name := "dep"; + dependencies := []; + }; diff --git a/tests/negative/AmbiguousPackageId/dep2/main.juvix b/tests/negative/AmbiguousPackageId/dep2/main.juvix new file mode 100644 index 0000000000..8bffabe306 --- /dev/null +++ b/tests/negative/AmbiguousPackageId/dep2/main.juvix @@ -0,0 +1 @@ +module main; From 0286f5f35e7fa51d9b7d0add7561fd8f19fb18ce Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 2 Dec 2024 18:58:45 +0100 Subject: [PATCH 15/25] error message --- .../Compiler/Pipeline/Loader/PathResolver.hs | 23 ++++++++++++++++++- .../Pipeline/Loader/PathResolver/Error.hs | 2 +- .../Pipeline/Package/Loader/PathResolver.hs | 18 --------------- 3 files changed, 23 insertions(+), 20 deletions(-) diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs index 5ec4d4867a..b27480c787 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs @@ -12,6 +12,7 @@ module Juvix.Compiler.Pipeline.Loader.PathResolver findPackageJuvixFiles, importNodePackageId, mkPackageInfoPackageId, + checkConflicts, ) where @@ -39,6 +40,23 @@ import Juvix.Extra.Paths import Juvix.Extra.Stdlib (ensureStdlib) import Juvix.Prelude +checkConflicts :: forall r'. (Members '[Error JuvixError] r') => [PackageInfo] -> Sem r' () +checkConflicts pkgs = do + let reps = findRepeatedOn (^. packageInfoPackageId) pkgs + case nonEmpty reps of + Just (rep :| _) -> errRep rep + Nothing -> return () + where + errRep :: (NonEmpty PackageInfo, PackageId) -> Sem r' () + errRep (l, pid) = + throw + . JuvixError + $ ErrAmbiguousPackageId + AmbiguousPackageId + { _ambiguousPackageId = pid, + _ambiguousPackageIdPackages = l + } + mkPackage :: forall r. (Members '[Files, Error JuvixError, Reader ResolverEnv, DependencyResolver, EvalFileEff] r) => @@ -445,7 +463,10 @@ runPathResolver2 st topEnv arg = do ) handler ) - arg + $ do + pkgs <- toList <$> getPackageInfos + checkConflicts pkgs + arg where handler :: forall t localEs x. diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs index eda55582fe..63e52316d9 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs @@ -206,4 +206,4 @@ instance PrettyCodeAnn AmbiguousPackageId where <> line <> "The above package id is the same for the following packages" <> line - <> itemize [] + <> itemize ((pretty . (^. packageRoot)) <$> _ambiguousPackageIdPackages) diff --git a/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs index 0981c5cac8..015203c9f5 100644 --- a/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Package/Loader/PathResolver.hs @@ -40,7 +40,6 @@ runPackagePathResolver rootPath sem = do fs <- rootInfoFiles ds let mkRootInfo' :: Path Rel File -> Maybe RootInfo = mkRootInfo ds fs packageInfos <- mkPackageInfos ds fs - checkConflicts (toList packageInfos) (`interpretH` sem) $ \localEnv -> \case SupportsParallel -> return False ResolverRoot -> return rootPath @@ -68,23 +67,6 @@ runPackagePathResolver rootPath sem = do -- the _root' is not used because ResolvePath does not depend on it runTSimpleEff localEnv m where - checkConflicts :: forall r'. (Members '[Error JuvixError] r') => [PackageInfo] -> Sem r' () - checkConflicts pkgs = do - let reps = findRepeatedOn (^. packageInfoPackageId) pkgs - case nonEmpty reps of - Just (rep :| _) -> errRep rep - Nothing -> return () - where - errRep :: (NonEmpty PackageInfo, PackageId) -> Sem r' () - errRep (l, pid) = - throw - . JuvixError - $ ErrAmbiguousPackageId - AmbiguousPackageId - { _ambiguousPackageId = pid, - _ambiguousPackageIdPackages = l - } - mkPackageInfos :: RootInfoDirs -> RootInfoFiles -> From ff8f6604b12e1ada949669773773c33d3030c59f Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Mon, 2 Dec 2024 19:45:33 +0100 Subject: [PATCH 16/25] disable check --- src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs index b27480c787..d800a13999 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs @@ -464,8 +464,9 @@ runPathResolver2 st topEnv arg = do handler ) $ do - pkgs <- toList <$> getPackageInfos - checkConflicts pkgs + _pkgs <- toList <$> getPackageInfos + -- I think we should not check for conflicts + -- checkConflicts pkgs arg where handler :: From 500af3fbdbc886c0d0647cdcd8bd5af9ba330c64 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Tue, 3 Dec 2024 12:46:02 +0100 Subject: [PATCH 17/25] Revert "update stdlib TEMPORARY" This reverts commit 05bf2198c28a40782bf615f938893c6226bdb08d. --- juvix-stdlib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/juvix-stdlib b/juvix-stdlib index 0c456725a2..fde9ac2353 160000 --- a/juvix-stdlib +++ b/juvix-stdlib @@ -1 +1 @@ -Subproject commit 0c456725a23648606f97aebf8f74a9e2a73e90b6 +Subproject commit fde9ac23534fe1c0ba3f69714233dbd1d3934a9c From 95d39c5d1c4752586952fd186d295839135c2236 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Tue, 3 Dec 2024 09:42:36 +0100 Subject: [PATCH 18/25] disable test --- test/Resolver/Negative.hs | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/test/Resolver/Negative.hs b/test/Resolver/Negative.hs index 6bfc057221..4763cbc194 100644 --- a/test/Resolver/Negative.hs +++ b/test/Resolver/Negative.hs @@ -69,12 +69,12 @@ resolverErrorTests = $ \case ErrMissingModule MissingModule {} -> Nothing - _ -> wrongError, - negTest - "Depend on two packages with the same package id" - $(mkRelDir "AmbiguousPackageId") - $(mkRelFile "Main.juvix") - $ \case - ErrAmbiguousPackageId {} -> Nothing _ -> wrongError + -- negTest + -- "Depend on two packages with the same package id" + -- $(mkRelDir "AmbiguousPackageId") + -- $(mkRelFile "Main.juvix") + -- $ \case + -- ErrAmbiguousPackageId {} -> Nothing + -- _ -> wrongError ] From 69eb03fc286db4478673eaab9d1af774f84cac98 Mon Sep 17 00:00:00 2001 From: Lukasz Czajka Date: Tue, 3 Dec 2024 10:24:38 +0100 Subject: [PATCH 19/25] preserve order of inductive type declarations in Core --- src/Juvix/Compiler/Core/Pretty/Base.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Juvix/Compiler/Core/Pretty/Base.hs b/src/Juvix/Compiler/Core/Pretty/Base.hs index ef0c03232b..e602a4e09f 100644 --- a/src/Juvix/Compiler/Core/Pretty/Base.hs +++ b/src/Juvix/Compiler/Core/Pretty/Base.hs @@ -574,7 +574,7 @@ instance PrettyCode InfoTable where ppCode :: forall r. (Member (Reader Options) r) => InfoTable -> Sem r (Doc Ann) ppCode tbl = do let header x = annotate AnnImportant (Str.commentLineStart <+> x) <> line - tys <- ppInductives (toList (tbl ^. infoInductives)) + tys <- ppInductives (sortOn (^. inductiveSymbol) $ toList (tbl ^. infoInductives)) sigs <- ppSigs (sortOn (^. identifierSymbol) $ toList (tbl ^. infoIdentifiers)) ctx' <- ppContext (tbl ^. identContext) axioms <- vsep <$> mapM ppCode (tbl ^. infoAxioms) From 822b4fe4c2f7367534d37c885aa515a06cd10e5b Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Tue, 3 Dec 2024 12:46:26 +0100 Subject: [PATCH 20/25] use juvix/main stdlib --- juvix-stdlib | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/juvix-stdlib b/juvix-stdlib index fde9ac2353..0c456725a2 160000 --- a/juvix-stdlib +++ b/juvix-stdlib @@ -1 +1 @@ -Subproject commit fde9ac23534fe1c0ba3f69714233dbd1d3934a9c +Subproject commit 0c456725a23648606f97aebf8f74a9e2a73e90b6 From 3076c8d77b8d010db5eb34adf1f38102c2930ce3 Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Tue, 3 Dec 2024 13:45:41 +0100 Subject: [PATCH 21/25] remove commented out test --- src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs | 3 ++- test/Resolver/Negative.hs | 7 ------- 2 files changed, 2 insertions(+), 8 deletions(-) diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs index 63e52316d9..01279829eb 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs @@ -94,7 +94,8 @@ data PathResolverError = ErrDependencyConflict DependencyConflict | ErrMissingModule MissingModule | ErrPackageInvalidImport PackageInvalidImport - | ErrAmbiguousPackageId AmbiguousPackageId + | -- | This error is unused at the moment + ErrAmbiguousPackageId AmbiguousPackageId deriving stock (Show) instance ToGenericError PathResolverError where diff --git a/test/Resolver/Negative.hs b/test/Resolver/Negative.hs index 4763cbc194..93f7b3a1be 100644 --- a/test/Resolver/Negative.hs +++ b/test/Resolver/Negative.hs @@ -70,11 +70,4 @@ resolverErrorTests = ErrMissingModule MissingModule {} -> Nothing _ -> wrongError - -- negTest - -- "Depend on two packages with the same package id" - -- $(mkRelDir "AmbiguousPackageId") - -- $(mkRelFile "Main.juvix") - -- $ \case - -- ErrAmbiguousPackageId {} -> Nothing - -- _ -> wrongError ] From a7ec1692ed9976f17e4067196d654ce1bf864e1d Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Tue, 3 Dec 2024 13:55:49 +0100 Subject: [PATCH 22/25] append hash including Package.juvix --- .../Compiler/Pipeline/Loader/PathResolver.hs | 20 ++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs index d800a13999..39f7018b0c 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver.hs @@ -18,6 +18,7 @@ where import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet +import Data.List.NonEmpty.Extra qualified as NonEmpty import Data.Versions qualified as Ver import Juvix.Compiler.Concrete.Data.Name import Juvix.Compiler.Concrete.Translation.FromParsed.Analysis.Scoping.Error @@ -76,16 +77,21 @@ findPackageJuvixFiles pkgRoot = map (fromJust . stripProperPrefix pkgRoot) <$> w newJuvixFiles :: [Path Abs File] newJuvixFiles = [cd f | f <- files, isJuvixOrJuvixMdFile f, not (isPackageFile f)] --- | If the file has a pre-release tag we keep it as it is. Otherwise we hash --- all juvix files in the package. +-- | Append the hash of all files in the project to the pre-release mkPackageInfoPackageId :: (Members '[Files] r) => Path Abs Dir -> [Path Rel File] -> PackageLike -> Sem r PackageId mkPackageInfoPackageId root pkgRelFiles pkgLike = do + let pkgDotJuvix = mkPackageFilePath root + pkgDotJuvixExists <- fileExists' pkgDotJuvix + let pkgJuvixFiles = [root rFile | rFile <- pkgRelFiles] let baseVersion = packageLikeVersion pkgLike - version <- case Ver._svPreRel baseVersion of - Nothing -> do - filesHash <- SHA256.digestFiles [root rFile | rFile <- pkgRelFiles] - return baseVersion {_svPreRel = Just (Ver.Release (pure (Ver.Alphanum filesHash)))} - Just {} -> return baseVersion + allFiles + | pkgDotJuvixExists = pkgDotJuvix : pkgJuvixFiles + | otherwise = pkgJuvixFiles + filesHash <- SHA256.digestFiles allFiles + let version = case Ver._svPreRel baseVersion of + Nothing -> + baseVersion {_svPreRel = Just (Ver.Release (pure (Ver.Alphanum filesHash)))} + Just (Ver.Release r) -> baseVersion {_svPreRel = Just (Ver.Release (NonEmpty.snoc r (Ver.Alphanum filesHash)))} return PackageId { _packageIdName = pkgLike ^. packageLikeName, From 95b418355c017e040c2209c60e6c06180b2960ba Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Thu, 5 Dec 2024 09:25:28 +0100 Subject: [PATCH 23/25] add comment --- src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs index 01279829eb..f0c0248c1c 100644 --- a/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs +++ b/src/Juvix/Compiler/Pipeline/Loader/PathResolver/Error.hs @@ -94,7 +94,8 @@ data PathResolverError = ErrDependencyConflict DependencyConflict | ErrMissingModule MissingModule | ErrPackageInvalidImport PackageInvalidImport - | -- | This error is unused at the moment + | -- | The ErrAmbiguousPackageId error is unused at the moment. We append the + -- hash of all project files to the pre-release tag of the package version. ErrAmbiguousPackageId AmbiguousPackageId deriving stock (Show) From 7c3c402a76d62e8d72cdf79f35c7cfa56af2d87a Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Thu, 5 Dec 2024 14:13:16 +0100 Subject: [PATCH 24/25] Squashed commit of the following: MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit commit 1a76df94869fe5ac9739082b5f28519803168748 Author: Łukasz Czajka <62751+lukaszcz@users.noreply.github.com> Date: Thu Dec 5 14:12:21 2024 +0100 Fix RISC0 CI (#3233) --- .github/workflows/ci.yml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index 044fce3b96..bc7d35c9c7 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -223,11 +223,13 @@ jobs: with: cache-on-failure: false + # cargo-risczero version needs to be updated to the latest version if the + # CI reports a version inconsistency error - name: Install RISC0 VM shell: bash run: | cargo install cargo-binstall@1.6.9 --force - cargo binstall cargo-risczero@1.1.1 --no-confirm --force + cargo binstall cargo-risczero@1.2.0 --no-confirm --force cargo risczero install - name: Checkout CairoVM From 37f30042532561b29082f60065932cb393172eec Mon Sep 17 00:00:00 2001 From: Jan Mas Rovira Date: Thu, 5 Dec 2024 14:22:01 +0100 Subject: [PATCH 25/25] deterministicly digest the files to create the hash --- src/Juvix/Data/SHA256.hs | 10 ++++++++-- src/Juvix/Prelude/Base/Foundation.hs | 4 ++++ 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/src/Juvix/Data/SHA256.hs b/src/Juvix/Data/SHA256.hs index 1af517989a..e5b21cdc69 100644 --- a/src/Juvix/Data/SHA256.hs +++ b/src/Juvix/Data/SHA256.hs @@ -50,6 +50,12 @@ ignoreSHA256Builder = interpret $ \case execSHA256Builder :: (Members '[Files] r) => Sem (SHA256Builder ': r) a -> Sem r Text execSHA256Builder = fmap fst . runSHA256Builder --- | Create a HEX encoded, SHA256 digest of the contents of some files +-- | Create a HEX encoded, SHA256 digest of the contents of some files in the +-- given order. Note that the order of the paths is relevant +digestFilesList :: (Members '[Files] r, Foldable l) => l (Path Abs File) -> Sem r Text +digestFilesList = execSHA256Builder . builderDigestFiles + +-- | Create a HEX encoded, SHA256 digest of the contents of the files. Order of +-- paths and repeated elements do not affect the result. digestFiles :: (Members '[Files] r, Foldable l) => l (Path Abs File) -> Sem r Text -digestFiles = execSHA256Builder . builderDigestFiles +digestFiles = digestFilesList . ordNubSort diff --git a/src/Juvix/Prelude/Base/Foundation.hs b/src/Juvix/Prelude/Base/Foundation.hs index 610cfbfc75..9a93688882 100644 --- a/src/Juvix/Prelude/Base/Foundation.hs +++ b/src/Juvix/Prelude/Base/Foundation.hs @@ -765,6 +765,10 @@ hashMapFromHashSetM s fun = hashMapFromHashSet :: (Hashable k) => HashSet k -> (k -> v) -> HashMap k v hashMapFromHashSet s fun = hashMap [(x, fun x) | x <- toList s] +-- | Sorts and removes duplicates +ordNubSort :: (Foldable f, Ord k) => f k -> [k] +ordNubSort = toList . ordSet + ordMap :: (Foldable f, Ord k) => f (k, v) -> Map k v ordMap = Map.fromList . toList