From 7847f3dd1c3097673b8265ca8112b51cc414c3aa Mon Sep 17 00:00:00 2001 From: Artem Pelenitsyn Date: Mon, 12 Oct 2026 09:01:36 -0400 Subject: [PATCH 1/6] Build, install and register packages with MicroHs Add a MicroHs backend to Cabal, Distribution.Simple.MHS, so that cabal-install can build simple packages with mhs: a library with exposed and other modules, and executables depending on it, in place or in the store. Cabal knows mhs as a program, whose version is that of mhs --numeric-version, and configure, build, install and register dispatch to the backend for the compiler flavour MHS. MicroHs compiles a library into a single package file, and finds installed packages through a search path of directories with an index of the modules they provide. Cabal maps its package databases onto this as follows (see Note [MicroHs package databases] in Distribution.Simple.MHS): * The global database is the default search path of mhs, reported by 'mhs -L'; its packages (base, MicroHs) are described by 'mhs -L' and get - as their unit id, which is what the solver and 'configure' then refer to. * A database of Cabal is a directory of .conf registration files; the package file of a library stays in its build directory or, once installed, in its library directory. * A component is compiled with the package files of its dependency closure preloaded (-p) and the search path cleared (-a), so that it sees exactly the packages it depends on, and a library rebuilt in place is picked up by its dependents without re-registration. Executables are linked by mhs into //, where cabal-install expects them, so 'cabal run' and 'cabal list-bin' work. 'Setup configure' gains a --mhs flag, the package databases are monitored for changes, and 'cabal path' knows the compiler program. The help texts of the commands in doc/ are regenerated for --mhs and the mhs program. The modules that preprocessors generate, which Cabal puts in the build directory of a component, are on the module search path of mhs after the source directories, and the main module of an executable is looked for there first, as with GHC. For changes in the package databases, cabal-install monitors their directories, their packages subdirectories, and the registration and package files in them, which are rewritten in place when a package is registered or installed again. The headers that hsc2hs generates beside the modules are on the include path, for the C it generates with them. The dependencies of a component are taken from the index of configure, which build keeps up to date with the libraries it builds; the package databases are read again only when a dependency is missing from it. The extra-lib-dirs of a component are made absolute before mhs stores them in the package file of a library, as the programs linked against it may be built elsewhere. Executables are compressed with -z, as MicroCabal does, so that the mhs that cabal builds is the size of the one its Makefile builds. Every extension is described as supported, as MicroCabal effectively does by not checking them: mhs has the extensions it implements always on, CPP excepted, and ignores the LANGUAGE pragmas of the others. Describing only the extensions it implements made Cabal reject packages for extensions they merely declare, often for the GHC side of a conditional: Trustworthy (parsec), DeriveGeneric (pretty), UnboxedTuples (unordered-containers, vault), TypeFamilies (newtype, contravariant, assoc), or NoGeneralizedNewtypeDeriving, for which the solver fell back from time-1.15, which supports mhs, to time-1.12.2. A package that needs an extension mhs lacks fails when mhs meets the syntax. reexported-modules are accepted too: mhs sees all the modules of the packages it loads, which include the dependencies of the dependencies of a component, so the modules a package re-exports are visible to the components depending on it, as long as they are not renamed; buildLib rejects a library that renames one. The errors of the backend are defined in Distribution.Simple.MHS too. Tested with mhs 0.16.9.0 and 0.15.4.0: cabal build/run/list-bin of a library with a hidden module plus an executable, an up-to-date rebuild, a rebuild after editing the hidden module, and 'cabal install' of the executable through the store. The test MHS/Build of cabal-testsuite covers the first of these, MHS/Preprocess builds modules that hsc2hs generates, and MHS/ReexportRenamed checks the rejection; they are skipped when mhs is not installed. Co-Authored-By: Claude Fable 5.1 Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_0176vAefrw8jPKXdh9h1wKuj --- Cabal/Cabal.cabal | 1 + Cabal/src/Distribution/Simple/Build.hs | 4 + Cabal/src/Distribution/Simple/Compiler.hs | 7 +- Cabal/src/Distribution/Simple/Configure.hs | 11 + Cabal/src/Distribution/Simple/Install.hs | 3 + Cabal/src/Distribution/Simple/MHS.hs | 609 ++++++++++++++++++ Cabal/src/Distribution/Simple/Program.hs | 1 + .../Distribution/Simple/Program/Builtin.hs | 8 + Cabal/src/Distribution/Simple/Register.hs | 4 + Cabal/src/Distribution/Simple/Setup/Config.hs | 1 + .../src/Distribution/Client/CmdPath.hs | 1 + .../PackageTests/MHS/Preprocess/app/Main.hsc | 14 + .../PackageTests/MHS/Preprocess/cabal.project | 3 + .../PackageTests/MHS/Preprocess/cabal.test.hs | 14 + .../MHS/Preprocess/mhs-preprocess.cabal | 18 + .../PackageTests/MHS/Preprocess/src/Sizes.hsc | 7 + .../MHS/ReexportRenamed/cabal.project | 3 + .../MHS/ReexportRenamed/cabal.test.hs | 10 + .../MHS/ReexportRenamed/mhs-reexport.cabal | 13 + .../MHS/ReexportRenamed/src/Greeting.hs | 4 + cabal-testsuite/PackageTests/MHS/app/Main.hs | 6 + .../PackageTests/MHS/cabal.project | 3 + .../PackageTests/MHS/cabal.test.hs | 8 + .../PackageTests/MHS/mhs-test.cabal | 19 + .../PackageTests/MHS/src/Greeting.hs | 6 + .../PackageTests/MHS/src/Greeting/Internal.hs | 4 + changelog.d/pr-11392.md | 23 + doc/cabal-package-description-file.rst | 2 +- doc/cabal-project-description-file.rst | 2 +- doc/cmd-v1-help/build.txt | 2 +- doc/cmd-v1-help/configure.txt | 3 +- doc/cmd-v1-help/install.txt | 3 +- doc/cmd-v1-help/reconfigure.txt | 1 + doc/cmd-v2-help/bench.txt | 1 + doc/cmd-v2-help/build.txt | 1 + doc/cmd-v2-help/configure.txt | 1 + doc/cmd-v2-help/exec.txt | 1 + doc/cmd-v2-help/freeze.txt | 1 + doc/cmd-v2-help/gen-bounds.txt | 1 + doc/cmd-v2-help/haddock.txt | 1 + doc/cmd-v2-help/install.txt | 1 + doc/cmd-v2-help/list-bin.txt | 1 + doc/cmd-v2-help/outdated.txt | 1 + doc/cmd-v2-help/path.txt | 1 + doc/cmd-v2-help/repl.txt | 1 + doc/cmd-v2-help/run.txt | 1 + doc/cmd-v2-help/target.txt | 1 + doc/cmd-v2-help/test.txt | 1 + doc/cmd-v2-help/update.txt | 1 + doc/config.rst | 2 + doc/setup-commands.rst | 4 +- doc/setup-help/build.txt | 2 +- doc/setup-help/configure.txt | 3 +- 53 files changed, 835 insertions(+), 10 deletions(-) create mode 100644 Cabal/src/Distribution/Simple/MHS.hs create mode 100644 cabal-testsuite/PackageTests/MHS/Preprocess/app/Main.hsc create mode 100644 cabal-testsuite/PackageTests/MHS/Preprocess/cabal.project create mode 100644 cabal-testsuite/PackageTests/MHS/Preprocess/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/MHS/Preprocess/mhs-preprocess.cabal create mode 100644 cabal-testsuite/PackageTests/MHS/Preprocess/src/Sizes.hsc create mode 100644 cabal-testsuite/PackageTests/MHS/ReexportRenamed/cabal.project create mode 100644 cabal-testsuite/PackageTests/MHS/ReexportRenamed/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/MHS/ReexportRenamed/mhs-reexport.cabal create mode 100644 cabal-testsuite/PackageTests/MHS/ReexportRenamed/src/Greeting.hs create mode 100644 cabal-testsuite/PackageTests/MHS/app/Main.hs create mode 100644 cabal-testsuite/PackageTests/MHS/cabal.project create mode 100644 cabal-testsuite/PackageTests/MHS/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/MHS/mhs-test.cabal create mode 100644 cabal-testsuite/PackageTests/MHS/src/Greeting.hs create mode 100644 cabal-testsuite/PackageTests/MHS/src/Greeting/Internal.hs create mode 100644 changelog.d/pr-11392.md diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 7b0fbc41139..8b9d2b8d791 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -163,6 +163,7 @@ library Distribution.Simple.Test.LibV09 Distribution.Simple.Test.Log Distribution.Simple.UHC + Distribution.Simple.MHS Distribution.Simple.UserHooks Distribution.Simple.SetupHooks.Errors Distribution.Simple.SetupHooks.HooksMain diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs index 4d40d7da6b5..546052df04d 100644 --- a/Cabal/src/Distribution/Simple/Build.hs +++ b/Cabal/src/Distribution/Simple/Build.hs @@ -70,6 +70,7 @@ import Distribution.Backpack import Distribution.Backpack.DescribeUnitId import Distribution.Package import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.MHS as MHS import qualified Distribution.Simple.PackageIndex as Index import qualified Distribution.Simple.UHC as UHC @@ -312,6 +313,7 @@ dumpBuildInfo verbosity distPref dumpBuildInfoFlag pkg_descr lbi flags = do flavorToProgram GHC = Just ghcProgram flavorToProgram UHC = Just uhcProgram flavorToProgram JHC = Just jhcProgram + flavorToProgram MHS = Just mhsProgram flavorToProgram _ = Nothing repl @@ -981,6 +983,7 @@ buildLib verbHandles flags numJobs pkg_descr lbi lib clbi = in case compilerFlavor (compiler lbi) of GHC -> GHC.buildLib verbHandles flags numJobs pkg_descr lbi lib clbi UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi + MHS -> MHS.buildLib verbosity pkg_descr lbi lib clbi _ -> dieWithException verbosity BuildingNotSupportedWithCompiler -- | Build a foreign library @@ -1012,6 +1015,7 @@ buildExe verbosity numJobs pkg_descr lbi exe clbi = case compilerFlavor (compiler lbi) of GHC -> GHC.buildExe verbosity numJobs pkg_descr lbi exe clbi UHC -> UHC.buildExe verbosity pkg_descr lbi exe clbi + MHS -> MHS.buildExe verbosity pkg_descr lbi exe clbi _ -> dieWithException verbosity BuildingNotSupportedWithCompiler replLib diff --git a/Cabal/src/Distribution/Simple/Compiler.hs b/Cabal/src/Distribution/Simple/Compiler.hs index 4e1d2e520ac..f55733a1915 100644 --- a/Cabal/src/Distribution/Simple/Compiler.hs +++ b/Cabal/src/Distribution/Simple/Compiler.hs @@ -535,9 +535,12 @@ extensionToFlag' comp ext = lookup ext (compilerExtensions comp) parmakeSupported :: Compiler -> Bool parmakeSupported = ghcSupported "Support parallel --make" --- | Does this compiler support reexported-modules? +-- | Does this compiler support reexported-modules? GHC says so in its +-- @--info@, from which its 'compilerProperties' come; other compilers can say +-- so in their 'compilerProperties' too. reexportedModulesSupported :: Compiler -> Bool -reexportedModulesSupported = ghcSupported "Support reexported-modules" +reexportedModulesSupported comp = + Map.lookup "Support reexported-modules" (compilerProperties comp) == Just "YES" -- | Does this compiler support thinning/renaming on package flags? renamingPackageFlagsSupported :: Compiler -> Bool diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index 78b13d60918..38aae4b79cc 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -131,6 +131,7 @@ import Distribution.Verbosity import Distribution.Version import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.MHS as MHS import qualified Distribution.Simple.UHC as UHC import Control.Exception @@ -2264,6 +2265,7 @@ getInstalledPackages verbosity comp mbWorkDir packageDBs progdb = do case compilerFlavor comp of GHC -> GHC.getInstalledPackages verbosity mbWorkDir packageDBs' progdb UHC -> UHC.getInstalledPackages verbosity comp mbWorkDir packageDBs' progdb + MHS -> MHS.getInstalledPackages verbosity comp mbWorkDir packageDBs' progdb flv -> dieWithException verbosity $ HowToFindInstalledPackages flv where @@ -2318,6 +2320,13 @@ getInstalledPackagesMonitorFiles verbosity comp mbWorkDir packageDBs progdb plat platform progdb packageDBs + MHS -> + MHS.getInstalledPackagesMonitorFiles + verbosity + comp + progdb + mbWorkDir + packageDBs other -> do warn verbosity $ "don't know how to find change monitoring files for " @@ -2696,6 +2705,7 @@ configCompilerEx (Just hcFlavor) hcPath hcPkg progdb verbosity = do GHC -> GHC.configure verbosity hcPath hcPkg progdb UHC -> UHC.configure verbosity hcPath progdb GHCJS -> dieWithException verbosity GHCJSNotSupported + MHS -> MHS.configure verbosity hcPath progdb _ -> dieWithException verbosity UnknownCompilerException return (comp, fromMaybe buildPlatform maybePlatform, programDb) @@ -2716,6 +2726,7 @@ configCompiler mbFlavor hcPath progdb verbosity = do GHC -> GHC.configureCompiler verbosity hcPath progdb UHC -> UHC.configure verbosity hcPath progdb GHCJS -> dieWithException verbosity GHCJSNotSupported + MHS -> MHS.configure verbosity hcPath progdb _ -> dieWithException verbosity UnknownCompilerException return (comp, fromMaybe buildPlatform maybePlatform, programDb) diff --git a/Cabal/src/Distribution/Simple/Install.hs b/Cabal/src/Distribution/Simple/Install.hs index ffcaad97556..c76dd0b3a9c 100644 --- a/Cabal/src/Distribution/Simple/Install.hs +++ b/Cabal/src/Distribution/Simple/Install.hs @@ -68,6 +68,7 @@ import Distribution.Utils.Path import Distribution.Compat.Graph (IsNode (..)) import Distribution.Simple.Errors import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.MHS as MHS import Distribution.Simple.Setup.Common import qualified Distribution.Simple.UHC as UHC @@ -244,6 +245,7 @@ copyComponent verbosity pkg_descr lbi (CLib lib) clbi copydest = do case compilerFlavor (compiler lbi) of GHC -> GHC.installLib verbosity lbi libPref dynlibPref bytecodeLibPref buildPref pkg_descr lib clbi UHC -> UHC.installLib verbosity lbi libPref dynlibPref bytecodeLibPref buildPref pkg_descr lib clbi + MHS -> MHS.installLib verbosity lbi libPref dynlibPref buildPref pkg_descr lib clbi _ -> dieWithException verbosity $ CompilerNotInstalled (compilerFlavor (compiler lbi)) copyComponent verbosity pkg_descr lbi (CFLib flib) clbi copydest = do @@ -290,6 +292,7 @@ copyComponent verbosity pkg_descr lbi (CExe exe) clbi copydest = do case compilerFlavor (compiler lbi) of GHC -> GHC.installExe verbosity lbi binPref buildPref progFix pkg_descr exe UHC -> return () + MHS -> MHS.installExe verbosity lbi binPref buildPref progFix pkg_descr exe _ -> dieWithException verbosity $ CompilerNotInstalled (compilerFlavor (compiler lbi)) diff --git a/Cabal/src/Distribution/Simple/MHS.hs b/Cabal/src/Distribution/Simple/MHS.hs new file mode 100644 index 00000000000..336c6f3e8ca --- /dev/null +++ b/Cabal/src/Distribution/Simple/MHS.hs @@ -0,0 +1,609 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RankNTypes #-} + +----------------------------------------------------------------------------- + +-- | +-- Module : Distribution.Simple.MHS +-- Copyright : Cabal Devs 2026 +-- License : BSD3 +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- This module contains most of the MicroHs-specific code for configuring, +-- building and installing packages. +-- +-- MicroHs (@mhs@, ) is a small Haskell +-- compiler that compiles to combinators. See Note [MicroHs package databases] +-- for how its packages are mapped onto the package databases of Cabal. +module Distribution.Simple.MHS + ( configure + , getInstalledPackages + , getInstalledPackagesMonitorFiles + , buildLib + , buildExe + , installLib + , installExe + , createPackageDB + , registerPackage + ) where + +import Distribution.Compat.Prelude +import Prelude () + +import Distribution.InstalledPackageInfo + ( ExposedModule (..) + , InstalledPackageInfo + , emptyInstalledPackageInfo + , parseInstalledPackageInfo + , showInstalledPackageInfo + ) +import qualified Distribution.InstalledPackageInfo as IPI +import Distribution.ModuleName (ModuleName) +import Distribution.Package hiding (installedUnitId) +import Distribution.PackageDescription +import Distribution.Parsec (simpleParsec) +import Distribution.Pretty +import Distribution.Simple.BuildPaths +import Distribution.Simple.Compiler +import Distribution.Simple.LocalBuildInfo +import Distribution.Simple.PackageIndex (InstalledPackageIndex) +import qualified Distribution.Simple.PackageIndex as PackageIndex +import Distribution.Simple.Program +import Distribution.Simple.Utils +import Distribution.System (Platform) +import Distribution.Types.MungedPackageId (computeCompatPackageId) +import Distribution.Types.MungedPackageName (MungedPackageName (..), decodeCompatPackageName) +import Distribution.Utils.Path +import Distribution.Verbosity +import Distribution.Version +import Language.Haskell.Extension + +import qualified Data.ByteString as BS +import qualified Data.Map as Map (fromList) +import qualified Data.Text as Text +import System.Directory (doesDirectoryExist, getDirectoryContents, getHomeDirectory, makeAbsolute) +import System.FilePath (takeDirectory, takeExtension, takeFileName) + +{- Note [MicroHs package databases] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +MicroHs compiles a library into a single package file, -.pkg, +which 'mhs -P-' writes. When compiling, mhs loads the package +files it is told to with -p, and finds the ones it is not told about +through its package search path: directories of the layout that +'mhs -Q ' creates, + + /packages/-.pkg the compiled package + //.txt one index file per exposed module, + naming the package that provides it + +A package database of Cabal is a directory of registration files, +/.conf, each the InstalledPackageInfo of a library, whose +package file stays where the library was built or installed: in its +library-dirs. When building a component, every package in the dependency +closure of the component is preloaded from there and the search path of mhs +is cleared, so that the component sees exactly the packages it depends on, as +it would with GHC. A library rebuilt in place is thus picked up by its +dependents without being registered again. + +GlobalPackageDB is the default search path of mhs, as 'mhs -L' reports it; it +holds the packages that come with mhs, such as base. UserPackageDB is +~/.mcabal/mhs-, where MicroCabal, the package manager of MicroHs, +installs packages for the user. The packages of these directories have no +registration file: they are described by what 'mhs -L' reports about +them, with - as their unit id. A directory given as +SpecificPackageDB may hold such packages too. +-} + +-- ----------------------------------------------------------------------------- +-- Configuring + +configure + :: Verbosity + -> Maybe FilePath + -> ProgramDb + -> IO (Compiler, Maybe Platform, ProgramDb) +configure verbosity hcPath progdb = do + (_mhsProg, mhsVersion, progdb') <- + requireProgramVersion + verbosity + mhsProgram + (orLaterVersion (mkVersion [0, 15])) + (userMaybeSpecifyPath "mhs" hcPath progdb) + + let comp = + Compiler + { compilerId = CompilerId MHS mhsVersion + , compilerAbiTag = NoAbiTag + , compilerCompat = [] + , compilerLanguages = mhsLanguages + , compilerExtensions = mhsLanguageExtensions + , compilerProperties = + -- mhs sees all the modules of the packages it loads, which + -- include the dependencies of the dependencies of a component, so + -- the modules a package re-exports are visible to the components + -- depending on it, as long as they are not renamed, which + -- 'buildLib' checks. + Map.fromList [("Support reexported-modules", "YES")] + , compilerWiredInUnitIds = Nothing + } + compPlatform = Nothing + return (comp, compPlatform, progdb') + +-- | MicroHs has all the extensions it supports enabled at all times, so it +-- accepts every language. +mhsLanguages :: [(Language, CompilerFlag)] +mhsLanguages = [(lang, "") | lang <- knownLanguages] + +-- | The extensions that MicroHs accepts: all of them. The extensions that mhs +-- implements are always on, except for CPP, and it ignores the LANGUAGE +-- pragmas of the others, so a package is not rejected for the extensions it +-- declares, which are often used only on the GHC side of a conditional. A +-- package that does need an extension that mhs does not implement fails when +-- mhs meets the syntax. The extensions that mhs implements are listed at +-- . +mhsLanguageExtensions :: [(Extension, Maybe CompilerFlag)] +mhsLanguageExtensions = + (EnableExtension CPP, Just "-XCPP") + : [(EnableExtension ext, Nothing) | ext <- knownExtensions, ext /= CPP] + ++ [(DisableExtension ext, Nothing) | ext <- knownExtensions] + ++ [(UnknownExtension ext, Nothing) | ext <- mhsSpecific] + where + -- Extensions of MicroHs that GHC does not have. + mhsSpecific = ["ExtraInstanceBindings", "ImportShadowing", "TypeLits"] + +-- ----------------------------------------------------------------------------- +-- Installed packages + +getInstalledPackages + :: Verbosity + -> Compiler + -> Maybe (SymbolicPath CWD (Dir from)) + -> PackageDBStackX (SymbolicPath from (Dir PkgDB)) + -> ProgramDb + -> IO InstalledPackageIndex +getInstalledPackages verbosity comp mbWorkDir packagedbs progdb = do + dirs <- packageDbDirs verbosity comp progdb mbWorkDir packagedbs + pkgs <- concat <$> traverse (readPackageDbDir verbosity progdb) dirs + return (PackageIndex.fromList pkgs) + +-- | What changes when the packages of the databases do: the directories of +-- the databases, where registration files and the packages subdirectory come +-- and go, the packages subdirectories, where package files come and go, and +-- the files themselves, which are rewritten in place when a package is +-- registered or installed again. See Note [MicroHs package databases]. +getInstalledPackagesMonitorFiles + :: Verbosity + -> Compiler + -> ProgramDb + -> Maybe (SymbolicPath CWD (Dir from)) + -> PackageDBStackX (SymbolicPath from (Dir PkgDB)) + -> IO [FilePath] +getInstalledPackagesMonitorFiles verbosity comp progdb mbWorkDir packagedbs = do + dirs <- packageDbDirs verbosity comp progdb mbWorkDir packagedbs + fmap concat $ for dirs $ \dir -> do + registrations <- filesWithExtension ".conf" dir + pkgFiles <- filesWithExtension ".pkg" (dir "packages") + return (dir : (dir "packages") : registrations ++ pkgFiles) + +-- | The directories of the given package databases, in order. +-- See Note [MicroHs package databases]. +packageDbDirs + :: Verbosity + -> Compiler + -> ProgramDb + -> Maybe (SymbolicPath CWD (Dir from)) + -> PackageDBStackX (SymbolicPath from (Dir PkgDB)) + -> IO [FilePath] +packageDbDirs verbosity comp progdb mbWorkDir packagedbs = + ordNub . concat <$> traverse dirsOf packagedbs + where + dirsOf GlobalPackageDB = globalPackageDbDirs verbosity progdb + dirsOf UserPackageDB = (: []) <$> userPackageDbDir comp + dirsOf (SpecificPackageDB dir) = return [interpretSymbolicPath mbWorkDir dir] + +-- | The default package search path of mhs, as @mhs -L@ lists it: +-- +-- > /path/to/mhs-0.16.9.0/packages: +-- > MicroHs-0.16.9.0 +-- > base-0.16.9.0 +globalPackageDbDirs :: Verbosity -> ProgramDb -> IO [FilePath] +globalPackageDbDirs verbosity progdb = do + output <- getDbProgramOutput verbosity mhsProgram progdb ["-L"] + -- The listing shows the packages subdirectories. + return + [ takeDirectory (dropWhileEnd (== ':') line) + | line@(c : _) <- lines output + , not (isSpace c) + , ":" `isSuffixOf` line + ] + +-- | Where MicroCabal installs packages for the user. +userPackageDbDir :: Compiler -> IO FilePath +userPackageDbDir comp = do + home <- getHomeDirectory + return (home ".mcabal" prettyShow (compilerId comp)) + +-- | The packages of a package database directory. +-- See Note [MicroHs package databases]. +readPackageDbDir :: Verbosity -> ProgramDb -> FilePath -> IO [InstalledPackageInfo] +readPackageDbDir verbosity progdb dir = do + registered <- traverse (readRegistrationFile verbosity) =<< filesWithExtension ".conf" dir + let registeredPkgFiles = map mhsPackageFileName registered + pkgFiles <- filesWithExtension ".pkg" (dir "packages") + unregistered <- + traverse (describePackageFile verbosity progdb) $ + [pkgFile | pkgFile <- pkgFiles, takeFileName pkgFile `notElem` registeredPkgFiles] + return (registered ++ catMaybes unregistered) + +-- | The paths of the files with the given extension in a directory, if the +-- directory exists. +filesWithExtension :: String -> FilePath -> IO [FilePath] +filesWithExtension ext dir = do + exists <- doesDirectoryExist dir + if exists + then do + files <- getDirectoryContents dir + return [dir file | file <- sort files, takeExtension file == ext] + else return [] + +-- | Read a registration file written by 'registerPackage'. +readRegistrationFile :: Verbosity -> FilePath -> IO InstalledPackageInfo +readRegistrationFile verbosity file = do + contents <- BS.readFile file + case parseInstalledPackageInfo contents of + Left errs -> dieWithException verbosity $ MhsRegistrationFileParseError file (toList errs) + Right (warnings, ipi) -> do + traverse_ (warn verbosity) warnings + return ipi + +-- | Describe a package that mhs or MicroCabal installed, from what +-- @mhs -L@ reports about it: +-- +-- > name: base +-- > version: 0.16.9.0 +-- > compiler: mhs-0.16.9.0 +-- > depends: +-- > linker opts: -lm +-- > exposed-modules: +-- > Control.Applicative +-- > ... +-- > other-modules: +-- > ... +describePackageFile :: Verbosity -> ProgramDb -> FilePath -> IO (Maybe InstalledPackageInfo) +describePackageFile verbosity progdb pkgFile = do + output <- getDbProgramOutput verbosity mhsProgram progdb ["-L" ++ pkgFile] + let fields = parseFields output + field name = fromMaybe [] (lookup name fields) + modules :: String -> [ModuleName] + modules name = mapMaybe simpleParsec (field name) + case (field "name", field "version") of + ([name], [versionStr]) + | Just version <- simpleParsec versionStr -> do + let MungedPackageName pname libname = decodeCompatPackageName (mkPackageName name) + pkgId = PackageIdentifier pname version + unitId = mkUnitId (mhsPackageId pkgId libname) + return $ + Just + emptyInstalledPackageInfo + { IPI.sourcePackageId = pkgId + , IPI.sourceLibName = libname + , IPI.installedUnitId = unitId + , IPI.installedComponentId_ = mkComponentId (unUnitId unitId) + , IPI.exposed = True + , IPI.exposedModules = [ExposedModule m Nothing | m <- modules "exposed-modules"] + , IPI.hiddenModules = modules "other-modules" + , IPI.depends = map mkUnitId (field "depends") + , IPI.libraryDirs = [takeDirectory pkgFile] + , IPI.ldOptions = field "linker opts" + } + _ -> do + warn verbosity $ + "Ignoring the MicroHs package file " ++ pkgFile ++ ", which mhs cannot describe." + return Nothing + +-- | Parse the fields of what @mhs -L@ reports: a @name: value@ line +-- starts a field, and the indented lines that follow continue it. The value +-- of a field is its words. +parseFields :: String -> [(String, [String])] +parseFields = go . lines + where + go [] = [] + go (line : rest) + | (name, ':' : value) <- break (== ':') line + , not (isIndented line) = + let (continuation, rest') = span isIndented rest + in (name, words value ++ concatMap words continuation) : go rest' + | otherwise = go rest + isIndented (c : _) = isSpace c + isIndented [] = False + +-- | The name under which mhs knows a library: @-@, with the +-- munged name of the library, so that the sub-libraries of a package get +-- distinct names. +mhsPackageId :: PackageId -> LibraryName -> String +mhsPackageId pkgId libname = prettyShow (computeCompatPackageId pkgId libname) + +-- | The name of the package file of a library, @-.pkg@. +mhsPackageFileName :: InstalledPackageInfo -> FilePath +mhsPackageFileName ipi = mhsPackageId (IPI.sourcePackageId ipi) (IPI.sourceLibName ipi) <.> "pkg" + +-- | The package file of a library, in one of its library directories; none if +-- the library has no modules and mhs hence nothing to load. +packageFile :: Verbosity -> InstalledPackageInfo -> IO (Maybe FilePath) +packageFile verbosity ipi = do + let fileName = mhsPackageFileName ipi + dirs = IPI.libraryDirs ipi + mbFile <- findFirstFile id [dir fileName | dir <- dirs] + case mbFile of + Just file -> return (Just file) + Nothing + | null (IPI.exposedModules ipi) && null (IPI.hiddenModules ipi) -> return Nothing + | otherwise -> dieWithException verbosity $ MhsPackageFileNotFound fileName dirs + +-- ----------------------------------------------------------------------------- +-- Building + +buildLib + :: Verbosity + -> PackageDescription + -> LocalBuildInfo + -> Library + -> ComponentLocalBuildInfo + -> IO () +buildLib verbosity pkg_descr lbi lib clbi = do + let bi = libBuildInfo lib + pkgId = mhsPackageId (packageId pkg_descr) (libName lib) + targetDir = componentBuildDir lbi clbi + pkgFile = targetDir makeRelativePathEx (pkgId <.> "pkg") + -- The modules given to mhs are the ones that the package exposes; it + -- finds the other modules through the imports. A library without exposed + -- modules has to expose its other modules to be of any use. + modules + | null (exposedModules lib) = otherModules bi + | otherwise = exposedModules lib + -- mhs provides the modules of a package under their own names only. + renamed = [r | r <- reexportedModules lib, moduleReexportName r /= moduleReexportOriginalName r] + unless (null renamed) $ + dieWithException verbosity $ + MhsRenamedReexports renamed + createDirectoryIfMissingVerbose verbosity True (interpretSymbolicPathLBI lbi targetDir) + unless (null (cSources bi)) $ + warn verbosity "MicroHs cannot include C sources in a library; ignoring them." + runMhs verbosity lbi bi clbi targetDir $ + ["-P" ++ pkgId, "-o", interpretSymbolicPathCWD pkgFile] + ++ map prettyShow modules + +buildExe + :: Verbosity + -> PackageDescription + -> LocalBuildInfo + -> Executable + -> ComponentLocalBuildInfo + -> IO () +buildExe verbosity _pkg_descr lbi exe clbi = do + let bi = buildInfo exe + exeName' = prettyShow (exeName exe) + targetDir = buildDir lbi makeRelativePathEx exeName' + exeFile = targetDir makeRelativePathEx (exeName' <.> exeExtension (hostPlatform lbi)) + u = interpretSymbolicPathCWD -- See Note [Symbolic paths] in Distribution.Utils.Path + -- The main module is in the build directory of the executable when a + -- preprocessor generated it. + generatedDir = exeBuildDir lbi exe + srcMainPath <- + findFileCwd verbosity (mbWorkDirLBI lbi) (coerceSymbolicPath generatedDir : sourceDirs bi) (modulePath exe) + createDirectoryIfMissingVerbose verbosity True (interpretSymbolicPathLBI lbi targetDir) + runMhs verbosity lbi bi clbi generatedDir $ + -- Compress the combinator code of the program, as MicroCabal does. + ["-z"] + ++ map u (cSources bi) + ++ ["-o", u exeFile, u srcMainPath] + +-- | Run mhs with the arguments common to libraries and executables, followed +-- by the given ones. +runMhs + :: Verbosity + -> LocalBuildInfo + -> BuildInfo + -> ComponentLocalBuildInfo + -> SymbolicPath Pkg (Dir Build) + -- ^ where the preprocessors put the modules they generated + -> [String] + -> IO () +runMhs verbosity lbi bi clbi generatedDir args = do + let comp = compiler lbi + mbWorkDir = mbWorkDirLBI lbi + progdb = withPrograms lbi + u = interpretSymbolicPathCWD -- See Note [Symbolic paths] in Distribution.Utils.Path + pkgFiles <- dependencyPackageFiles verbosity lbi clbi + -- The extra-lib-dirs are made absolute, as the package file of a library + -- keeps the linker options for the programs linked elsewhere. + libDirs <- traverse (makeAbsolute . interpretSymbolicPathLBI lbi) (extraLibDirs bi) + let commonArgs = + mhsVerbosityFlags verbosity + -- The module search path: the source directories of the component + -- instead of the default, the current directory. + ++ ["-i"] + ++ ["-i" ++ u dir | dir <- sourceDirs bi] + -- The modules that preprocessors generated, from .hsc files say, + -- are in the build directory of the component. + ++ ["-i" ++ u generatedDir] + ++ ["-i" ++ u (autogenComponentModulesDir lbi clbi)] + ++ ["-i" ++ u (autogenPackageModulesDir lbi)] + -- The packages: the dependencies of the component, preloaded, instead + -- of whatever is on the package search path. + -- See Note [MicroHs package databases]. + ++ ["-a"] + ++ ["-p" ++ pkgFile | pkgFile <- pkgFiles] + ++ languageToFlags comp (defaultLanguage bi) + ++ extensionsToFlags comp (usedExtensions bi) + -- The headers that hsc2hs generates beside the modules, for the C + -- it generates with them. + ++ ["-I" ++ u generatedDir] + -- mhs passes only -D and -I options on to cpphs. + ++ [opt | opt <- map Text.unpack (cppOptions bi), any (`isPrefixOf` opt) ["-D", "-I"]] + ++ ["-I" ++ u dir | dir <- includeDirs bi] + ++ map Text.unpack (hcOptions MHS bi) + ++ concat [["-optl", opt] | opt <- linkerOptions] + linkerOptions = + ["-L" ++ dir | dir <- libDirs] + ++ ["-l" ++ Text.unpack lib | lib <- extraLibs bi] + ++ map Text.unpack (ldOptions bi) + runDbProgramCwd verbosity mbWorkDir mhsProgram progdb (commonArgs ++ args) + +-- | The package files of the dependencies of a component, closed under the +-- dependencies of the dependencies. +dependencyPackageFiles :: Verbosity -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO [FilePath] +dependencyPackageFiles verbosity lbi clbi = do + -- The index of configure, with the libraries built since threaded in by + -- build, has the dependencies, unless they were registered since the package + -- was configured: then the package databases are read again. + closure <- case PackageIndex.dependencyClosure (installedPkgs lbi) deps of + Left closure -> return (PackageIndex.allPackages closure) + Right _ -> do + index <- + getInstalledPackages verbosity (compiler lbi) (mbWorkDirLBI lbi) (withPackageDB lbi) (withPrograms lbi) + case PackageIndex.dependencyClosure index deps of + Left closure -> return (PackageIndex.allPackages closure) + Right broken -> + dieWithException verbosity $ + MhsMissingDependencies $ + ordNub $ + [dep | dep <- deps, isNothing (PackageIndex.lookupUnitId index dep)] + ++ concatMap snd broken + catMaybes <$> traverse (packageFile verbosity) closure + where + deps = map fst (componentPackageDeps clbi) + +-- | The source directories of a component; the package directory if none are +-- given. +sourceDirs :: BuildInfo -> [SymbolicPath Pkg (Dir Source)] +sourceDirs bi + | null (hsSourceDirs bi) = [sameDirectory] + | otherwise = ordNub (hsSourceDirs bi) + +mhsVerbosityFlags :: Verbosity -> [String] +mhsVerbosityFlags verbosity + | verbosityLevel verbosity >= Deafening = ["-v", "-v"] + | verbosityLevel verbosity >= Verbose = ["-v"] + | verbosityLevel verbosity < Normal = ["-q"] + | otherwise = [] + +-- ----------------------------------------------------------------------------- +-- Installation + +installLib + :: Verbosity + -> LocalBuildInfo + -> FilePath + -- ^ install location + -> FilePath + -- ^ install location for dynamic libraries (unused) + -> FilePath + -- ^ build location + -> PackageDescription + -> Library + -> ComponentLocalBuildInfo + -> IO () +installLib verbosity _lbi targetDir _dynlibTargetDir builtDir pkg lib _clbi = do + let pkgFile = mhsPackageId (packageId pkg) (libName lib) <.> "pkg" + createDirectoryIfMissingVerbose verbosity True targetDir + installOrdinaryFile verbosity (builtDir pkgFile) (targetDir pkgFile) + +installExe + :: Verbosity + -> LocalBuildInfo + -> FilePath + -- ^ install location + -> FilePath + -- ^ build location + -> (FilePath, FilePath) + -- ^ executable (prefix, suffix) + -> PackageDescription + -> Executable + -> IO () +installExe verbosity lbi binDir buildPref (progprefix, progsuffix) _pkg exe = do + let exeName' = prettyShow (exeName exe) + ext = exeExtension (hostPlatform lbi) + createDirectoryIfMissingVerbose verbosity True binDir + installExecutableFile + verbosity + (buildPref exeName' exeName' <.> ext) + (binDir progprefix ++ exeName' ++ progsuffix <.> ext) + +-- ----------------------------------------------------------------------------- +-- Registering + +-- | An empty package database is an empty directory. +-- See Note [MicroHs package databases]. +createPackageDB :: Verbosity -> FilePath -> IO () +createPackageDB verbosity dbPath = + createDirectoryIfMissingVerbose verbosity True dbPath + +-- | Register a library by writing its registration file into the database. +-- See Note [MicroHs package databases]. +registerPackage + :: Verbosity + -> Maybe (SymbolicPath CWD (Dir from)) + -> Compiler + -> ProgramDb + -> PackageDBStackS from + -> InstalledPackageInfo + -> IO () +registerPackage verbosity mbWorkDir comp progdb packageDbs installedPkgInfo = do + dbDir <- case registrationPackageDB packageDbs of + GlobalPackageDB -> do + dirs <- globalPackageDbDirs verbosity progdb + case dirs of + dir : _ -> return dir + [] -> dieWithException verbosity MhsNoGlobalPackageDb + UserPackageDB -> userPackageDbDir comp + SpecificPackageDB dir -> return (interpretSymbolicPath mbWorkDir dir) + createDirectoryIfMissingVerbose verbosity True dbDir + writeUTF8File + (dbDir prettyShow (IPI.installedUnitId installedPkgInfo) <.> "conf") + (showInstalledPackageInfo installedPkgInfo) + +-- ----------------------------------------------------------------------------- +-- Errors + +-- | The errors of building with MicroHs. +data MhsException + = MhsNoGlobalPackageDb + | MhsPackageFileNotFound FilePath [FilePath] + | MhsRegistrationFileParseError FilePath [String] + | MhsMissingDependencies [UnitId] + | MhsRenamedReexports [ModuleReexport] + deriving (Show) + +instance Exception (VerboseException MhsException) where + displayException (VerboseException stack timestamp verb err) = + withOutputMarker verb ("Error: [Cabal-" ++ show (mhsExceptionCode err) ++ "]\n") + ++ exceptionWithMetadata stack timestamp verb (mhsExceptionMessage err) + +mhsExceptionCode :: MhsException -> Int +mhsExceptionCode err = case err of + MhsNoGlobalPackageDb{} -> 3201 + MhsPackageFileNotFound{} -> 3202 + MhsRegistrationFileParseError{} -> 3203 + MhsMissingDependencies{} -> 3204 + MhsRenamedReexports{} -> 3205 + +mhsExceptionMessage :: MhsException -> String +mhsExceptionMessage err = case err of + MhsNoGlobalPackageDb -> + "mhs does not report a package directory to register the package in (see 'mhs -L')." + MhsPackageFileNotFound pkgFile dirs -> + "Cannot find the MicroHs package file " ++ pkgFile ++ " in " ++ intercalate ", " dirs + MhsRegistrationFileParseError file errs -> + "Failed to parse the package registration file " ++ file ++ ":\n" ++ unlines errs + MhsMissingDependencies unitIds -> + "Failed to find the installed units " + ++ intercalate ", " (map prettyShow unitIds) + ++ " in the package database stack." + MhsRenamedReexports reexports -> + "MicroHs provides the modules of a package under their own names only, so a library cannot re-export modules under other names: " + ++ intercalate ", " (map prettyShow reexports) diff --git a/Cabal/src/Distribution/Simple/Program.hs b/Cabal/src/Distribution/Simple/Program.hs index 87e2e97827a..4880ecc4676 100644 --- a/Cabal/src/Distribution/Simple/Program.hs +++ b/Cabal/src/Distribution/Simple/Program.hs @@ -107,6 +107,7 @@ module Distribution.Simple.Program , ghcPkgProgram , jhcProgram , uhcProgram + , mhsProgram , gccProgram , gppProgram , arProgram diff --git a/Cabal/src/Distribution/Simple/Program/Builtin.hs b/Cabal/src/Distribution/Simple/Program/Builtin.hs index f0317e42f7c..c9b1becd3f0 100644 --- a/Cabal/src/Distribution/Simple/Program/Builtin.hs +++ b/Cabal/src/Distribution/Simple/Program/Builtin.hs @@ -20,6 +20,7 @@ module Distribution.Simple.Program.Builtin , runghcProgram , jhcProgram , uhcProgram + , mhsProgram , gccProgram , gppProgram , arProgram @@ -72,6 +73,7 @@ builtinPrograms = , ghcPkgProgram , jhcProgram , uhcProgram + , mhsProgram , hpcProgram , -- preprocessors hscolourProgram @@ -159,6 +161,12 @@ uhcProgram = { programFindVersion = findProgramVersion "--version-dotted" id } +mhsProgram :: Program +mhsProgram = + (simpleProgram "mhs") + { programFindVersion = findProgramVersion "--numeric-version" id + } + hpcProgram :: Program hpcProgram = (simpleProgram "hpc") diff --git a/Cabal/src/Distribution/Simple/Register.hs b/Cabal/src/Distribution/Simple/Register.hs index 15d1a4bd48b..c2ff48e8a35 100644 --- a/Cabal/src/Distribution/Simple/Register.hs +++ b/Cabal/src/Distribution/Simple/Register.hs @@ -56,6 +56,7 @@ import Distribution.Simple.BuildTarget import Distribution.Simple.LocalBuildInfo import qualified Distribution.Simple.GHC as GHC +import qualified Distribution.Simple.MHS as MHS import qualified Distribution.Simple.PackageIndex as Index import qualified Distribution.Simple.UHC as UHC @@ -254,6 +255,7 @@ registerAll verbHandles pkg lbi regFlags ipis = writeRegisterScript = case compilerFlavor (compiler lbi) of UHC -> notice verbosity "Registration scripts not needed for uhc" + MHS -> notice verbosity "Registration scripts not needed for mhs" _ -> withHcPkg verbosity @@ -377,6 +379,7 @@ createPackageDB verbosity comp progdb dbPath = case compilerFlavor comp of GHC -> HcPkg.init (GHC.hcPkgInfo progdb) verbosity dbPath UHC -> return () + MHS -> MHS.createPackageDB verbosity dbPath _ -> dieWithException verbosity CreatePackageDB doesPackageDBExist :: FilePath -> IO Bool @@ -434,6 +437,7 @@ registerPackage registerPackage verbosity comp progdb mbWorkDir packageDbs installedPkgInfo registerOptions = case compilerFlavor comp of GHC -> GHC.registerPackage verbosity progdb mbWorkDir packageDbs installedPkgInfo registerOptions + MHS -> MHS.registerPackage verbosity mbWorkDir comp progdb packageDbs installedPkgInfo _ | HcPkg.registerMultiInstance registerOptions -> dieWithException verbosity RegisMultiplePkgNotSupported diff --git a/Cabal/src/Distribution/Simple/Setup/Config.hs b/Cabal/src/Distribution/Simple/Setup/Config.hs index aa8222e5ce9..7e8a2fe59a8 100644 --- a/Cabal/src/Distribution/Simple/Setup/Config.hs +++ b/Cabal/src/Distribution/Simple/Setup/Config.hs @@ -436,6 +436,7 @@ configureOptions showOrParseArgs = ( choiceOpt [ (Flag GHC, ("g", ["ghc"]), "Compile with GHC") , (Flag UHC, ([], ["uhc"]), "Compile with UHC") + , (Flag MHS, ([], ["mhs"]), "Compile with MHS") ] ) , option diff --git a/cabal-install/src/Distribution/Client/CmdPath.hs b/cabal-install/src/Distribution/Client/CmdPath.hs index 49e88a15e58..bad0bfbf38b 100644 --- a/cabal-install/src/Distribution/Client/CmdPath.hs +++ b/cabal-install/src/Distribution/Client/CmdPath.hs @@ -306,6 +306,7 @@ requireCompilerProg :: Verbosity -> Compiler -> IO Program requireCompilerProg verbosity compiler = case compilerFlavor compiler of GHC -> pure ghcProgram + MHS -> pure mhsProgram flavour -> die' verbosity $ "path: Unsupported compiler flavour: " diff --git a/cabal-testsuite/PackageTests/MHS/Preprocess/app/Main.hsc b/cabal-testsuite/PackageTests/MHS/Preprocess/app/Main.hsc new file mode 100644 index 00000000000..911c174ed17 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/Preprocess/app/Main.hsc @@ -0,0 +1,14 @@ +module Main (main) where + +import Sizes (intSize) + +#include + +-- | The bits of a C char, filled in by hsc2hs. +charBits :: Int +charBits = #const CHAR_BIT + +main :: IO () +main = do + putStrLn ("sizeof int = " ++ show intSize) + putStrLn ("char bits = " ++ show charBits) diff --git a/cabal-testsuite/PackageTests/MHS/Preprocess/cabal.project b/cabal-testsuite/PackageTests/MHS/Preprocess/cabal.project new file mode 100644 index 00000000000..3dccaec797b --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/Preprocess/cabal.project @@ -0,0 +1,3 @@ +packages: . +compiler: mhs +with-compiler: mhs diff --git a/cabal-testsuite/PackageTests/MHS/Preprocess/cabal.test.hs b/cabal-testsuite/PackageTests/MHS/Preprocess/cabal.test.hs new file mode 100644 index 00000000000..1d643728d67 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/Preprocess/cabal.test.hs @@ -0,0 +1,14 @@ +import Test.Cabal.Prelude + +-- The modules that a preprocessor generates, with MicroHs, if it is installed +-- along with hsc2hs: a module of the library and the main module of the +-- executable come from .hsc files, which hsc2hs turns into Haskell in the +-- build directories, where mhs has to find them. +main = cabalTest $ do + skipUnless "no mhs" =<< isAvailableProgram mhsProgram + skipUnless "no hsc2hs" =<< isAvailableProgram hsc2hsProgram + recordMode DoNotRecord $ do + cabal "v2-build" ["all"] + out <- cabal' "v2-run" ["mhs-preprocess"] + assertOutputContains "sizeof int = 4" out + assertOutputContains "char bits = 8" out diff --git a/cabal-testsuite/PackageTests/MHS/Preprocess/mhs-preprocess.cabal b/cabal-testsuite/PackageTests/MHS/Preprocess/mhs-preprocess.cabal new file mode 100644 index 00000000000..54eda27823f --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/Preprocess/mhs-preprocess.cabal @@ -0,0 +1,18 @@ +cabal-version: 3.0 +name: mhs-preprocess +version: 1.0 +build-type: Simple +license: BSD-3-Clause +synopsis: Modules that a preprocessor generates, with MicroHs + +library + exposed-modules: Sizes + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 + +executable mhs-preprocess + main-is: Main.hs + build-depends: base, mhs-preprocess + hs-source-dirs: app + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/MHS/Preprocess/src/Sizes.hsc b/cabal-testsuite/PackageTests/MHS/Preprocess/src/Sizes.hsc new file mode 100644 index 00000000000..5131294e649 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/Preprocess/src/Sizes.hsc @@ -0,0 +1,7 @@ +module Sizes (intSize) where + +#include + +-- | The size of a C int, filled in by hsc2hs. +intSize :: Int +intSize = #size int diff --git a/cabal-testsuite/PackageTests/MHS/ReexportRenamed/cabal.project b/cabal-testsuite/PackageTests/MHS/ReexportRenamed/cabal.project new file mode 100644 index 00000000000..3dccaec797b --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/ReexportRenamed/cabal.project @@ -0,0 +1,3 @@ +packages: . +compiler: mhs +with-compiler: mhs diff --git a/cabal-testsuite/PackageTests/MHS/ReexportRenamed/cabal.test.hs b/cabal-testsuite/PackageTests/MHS/ReexportRenamed/cabal.test.hs new file mode 100644 index 00000000000..a00d7abcdcd --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/ReexportRenamed/cabal.test.hs @@ -0,0 +1,10 @@ +import Test.Cabal.Prelude + +-- A library that re-exports a module under another name does not build with +-- MicroHs, if it is installed: mhs sees the modules of the packages it loads +-- under their own names only, so Cabal rejects the renaming. +main = cabalTest $ do + skipUnless "no mhs" =<< isAvailableProgram mhsProgram + recordMode DoNotRecord $ do + r <- fails $ cabal' "v2-build" ["all"] + assertOutputContains "Data.Char as Characters" r diff --git a/cabal-testsuite/PackageTests/MHS/ReexportRenamed/mhs-reexport.cabal b/cabal-testsuite/PackageTests/MHS/ReexportRenamed/mhs-reexport.cabal new file mode 100644 index 00000000000..b15df15f442 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/ReexportRenamed/mhs-reexport.cabal @@ -0,0 +1,13 @@ +cabal-version: 3.0 +name: mhs-reexport +version: 1.0 +build-type: Simple +license: BSD-3-Clause +synopsis: A re-exported module under another name, which MicroHs cannot provide + +library + exposed-modules: Greeting + reexported-modules: Data.Char as Characters + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/MHS/ReexportRenamed/src/Greeting.hs b/cabal-testsuite/PackageTests/MHS/ReexportRenamed/src/Greeting.hs new file mode 100644 index 00000000000..6b692c3821a --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/ReexportRenamed/src/Greeting.hs @@ -0,0 +1,4 @@ +module Greeting (greeting) where + +greeting :: String +greeting = "Hello from MicroHs" diff --git a/cabal-testsuite/PackageTests/MHS/app/Main.hs b/cabal-testsuite/PackageTests/MHS/app/Main.hs new file mode 100644 index 00000000000..c84c6b1a2f7 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/app/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Greeting (greeting) + +main :: IO () +main = putStrLn greeting diff --git a/cabal-testsuite/PackageTests/MHS/cabal.project b/cabal-testsuite/PackageTests/MHS/cabal.project new file mode 100644 index 00000000000..3dccaec797b --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/cabal.project @@ -0,0 +1,3 @@ +packages: . +compiler: mhs +with-compiler: mhs diff --git a/cabal-testsuite/PackageTests/MHS/cabal.test.hs b/cabal-testsuite/PackageTests/MHS/cabal.test.hs new file mode 100644 index 00000000000..4d32477de02 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/cabal.test.hs @@ -0,0 +1,8 @@ +import Test.Cabal.Prelude + +-- Build and run a package with MicroHs, if it is installed. +main = cabalTest $ do + skipUnless "no mhs" =<< isAvailableProgram mhsProgram + recordMode DoNotRecord $ do + cabal "v2-build" ["all"] + cabal' "v2-run" ["mhs-test"] >>= assertOutputContains "Hello from MicroHs" diff --git a/cabal-testsuite/PackageTests/MHS/mhs-test.cabal b/cabal-testsuite/PackageTests/MHS/mhs-test.cabal new file mode 100644 index 00000000000..71ba6cb6200 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/mhs-test.cabal @@ -0,0 +1,19 @@ +cabal-version: 3.0 +name: mhs-test +version: 1.0 +build-type: Simple +license: BSD-3-Clause +synopsis: A package to build with MicroHs + +library + exposed-modules: Greeting + other-modules: Greeting.Internal + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 + +executable mhs-test + main-is: Main.hs + build-depends: base, mhs-test + hs-source-dirs: app + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/MHS/src/Greeting.hs b/cabal-testsuite/PackageTests/MHS/src/Greeting.hs new file mode 100644 index 00000000000..e8184dc50ed --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/src/Greeting.hs @@ -0,0 +1,6 @@ +module Greeting (greeting) where + +import Greeting.Internal (compilerName) + +greeting :: String +greeting = "Hello from " ++ compilerName diff --git a/cabal-testsuite/PackageTests/MHS/src/Greeting/Internal.hs b/cabal-testsuite/PackageTests/MHS/src/Greeting/Internal.hs new file mode 100644 index 00000000000..98c92da6ae5 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/src/Greeting/Internal.hs @@ -0,0 +1,4 @@ +module Greeting.Internal (compilerName) where + +compilerName :: String +compilerName = "MicroHs" diff --git a/changelog.d/pr-11392.md b/changelog.d/pr-11392.md new file mode 100644 index 00000000000..62684547999 --- /dev/null +++ b/changelog.d/pr-11392.md @@ -0,0 +1,23 @@ +--- +synopsis: Build packages with MicroHs +packages: [Cabal, cabal-install] +prs: 11392 +significance: significant +--- + +Cabal and cabal-install can now configure, build, install and register +packages with MicroHs (`mhs`, https://github.com/augustss/MicroHs), a small +Haskell compiler. Select it with `compiler: mhs` and `with-compiler: mhs` in +`cabal.project`, or with `Setup configure --mhs`. + +The packages that come with mhs, such as `base`, are found through `mhs -L`. +The libraries that Cabal builds are compiled into mhs package files, which the +components depending on them preload, so that each component sees exactly the +packages it depends on. Only what simple packages need is implemented; there +is no support for Backpack, foreign libraries, profiling, shared libraries or +C sources in libraries. + +Since mhs ignores the `LANGUAGE` pragmas of the extensions it does not +implement, packages are not rejected for the extensions they declare, and +`reexported-modules` are accepted, as mhs sees all the modules of the +packages it loads, unless they rename modules, which mhs cannot do. diff --git a/doc/cabal-package-description-file.rst b/doc/cabal-package-description-file.rst index b43539e0705..593b05d345d 100644 --- a/doc/cabal-package-description-file.rst +++ b/doc/cabal-package-description-file.rst @@ -265,7 +265,7 @@ The syntax of the value depends on the field. Field types include: *identifier* A letter followed by zero or more alphanumerics or underscores. *compiler* - A compiler flavor (one of: ``GHC``, ``UHC`` or ``LHC``) + A compiler flavor (one of: ``GHC``, ``GHCJS``, ``MHS``, ``UHC`` or ``LHC``) followed by a version range. For example, ``GHC ==6.10.3``, or ``LHC >=0.6 && <0.8``. diff --git a/doc/cabal-project-description-file.rst b/doc/cabal-project-description-file.rst index 3530cf23051..a7711725947 100644 --- a/doc/cabal-project-description-file.rst +++ b/doc/cabal-project-description-file.rst @@ -1157,7 +1157,7 @@ feature was added. The command line variant of this flag is ``--configure-option=arg``, which can be specified multiple times to pass multiple options. -.. cfg-field:: compiler: ghc, jhc, lhc, or uhc +.. cfg-field:: compiler: ghc, jhc, lhc, uhc, or mhs --compiler=compiler :synopsis: Compiler to build with. diff --git a/doc/cmd-v1-help/build.txt b/doc/cmd-v1-help/build.txt index 8d4873dae7d..7c81a3f3a02 100644 --- a/doc/cmd-v1-help/build.txt +++ b/doc/cmd-v1-help/build.txt @@ -31,7 +31,7 @@ Examples: The flags --with-PROG and --PROG-option(s) can be used with the following programs: alex ar c2hs cpphs doctest gcc ghc ghc-pkg haddock happy hpc hsc2hs hscolour - jhc ld pkg-config runghc strip tar uhc + jhc ld mhs pkg-config runghc strip tar uhc The v1-build command is a part of the legacy v1 style of cabal usage. diff --git a/doc/cmd-v1-help/configure.txt b/doc/cmd-v1-help/configure.txt index 8ae0e879c7b..3b885982915 100644 --- a/doc/cmd-v1-help/configure.txt +++ b/doc/cmd-v1-help/configure.txt @@ -17,6 +17,7 @@ Flags for v1-configure: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool @@ -206,7 +207,7 @@ Flags for v1-configure: The flags --with-PROG and --PROG-option(s) can be used with the following programs: alex ar c2hs cpphs doctest gcc ghc ghc-pkg haddock happy hpc hsc2hs hscolour - jhc ld pkg-config runghc strip tar uhc + jhc ld mhs pkg-config runghc strip tar uhc Examples: cabal v1-configure diff --git a/doc/cmd-v1-help/install.txt b/doc/cmd-v1-help/install.txt index 9ff8d062e2e..7e013968a7b 100644 --- a/doc/cmd-v1-help/install.txt +++ b/doc/cmd-v1-help/install.txt @@ -28,6 +28,7 @@ Flags for v1-install: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool @@ -375,7 +376,7 @@ Flags for v1-install: The flags --with-PROG and --PROG-option(s) can be used with the following programs: alex ar c2hs cpphs doctest gcc ghc ghc-pkg haddock happy hpc hsc2hs hscolour - jhc ld pkg-config runghc strip tar uhc + jhc ld mhs pkg-config runghc strip tar uhc Examples: cabal v1-install Package in the current directory diff --git a/doc/cmd-v1-help/reconfigure.txt b/doc/cmd-v1-help/reconfigure.txt index 8d32929356b..8ed4d51ee09 100644 --- a/doc/cmd-v1-help/reconfigure.txt +++ b/doc/cmd-v1-help/reconfigure.txt @@ -16,6 +16,7 @@ Flags for v1-reconfigure: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/bench.txt b/doc/cmd-v2-help/bench.txt index 3673a0135e5..f58a80ce7d3 100644 --- a/doc/cmd-v2-help/bench.txt +++ b/doc/cmd-v2-help/bench.txt @@ -21,6 +21,7 @@ Flags for bench: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/build.txt b/doc/cmd-v2-help/build.txt index 026d5f13a39..19cae682254 100644 --- a/doc/cmd-v2-help/build.txt +++ b/doc/cmd-v2-help/build.txt @@ -21,6 +21,7 @@ Flags for build: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/configure.txt b/doc/cmd-v2-help/configure.txt index 4fe69c01f31..83a3887e359 100644 --- a/doc/cmd-v2-help/configure.txt +++ b/doc/cmd-v2-help/configure.txt @@ -34,6 +34,7 @@ Flags for configure: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/exec.txt b/doc/cmd-v2-help/exec.txt index e6418914ff0..530cbe41684 100644 --- a/doc/cmd-v2-help/exec.txt +++ b/doc/cmd-v2-help/exec.txt @@ -23,6 +23,7 @@ Flags for exec: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/freeze.txt b/doc/cmd-v2-help/freeze.txt index 923faf4f2eb..60a582dc44a 100644 --- a/doc/cmd-v2-help/freeze.txt +++ b/doc/cmd-v2-help/freeze.txt @@ -26,6 +26,7 @@ Flags for freeze: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/gen-bounds.txt b/doc/cmd-v2-help/gen-bounds.txt index 2343eb8c497..79d706a128a 100644 --- a/doc/cmd-v2-help/gen-bounds.txt +++ b/doc/cmd-v2-help/gen-bounds.txt @@ -12,6 +12,7 @@ Flags for gen-bounds: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/haddock.txt b/doc/cmd-v2-help/haddock.txt index 06647d8dd98..2b89614a37d 100644 --- a/doc/cmd-v2-help/haddock.txt +++ b/doc/cmd-v2-help/haddock.txt @@ -26,6 +26,7 @@ Flags for haddock: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/install.txt b/doc/cmd-v2-help/install.txt index 2ec898208b7..5a4ff679d96 100644 --- a/doc/cmd-v2-help/install.txt +++ b/doc/cmd-v2-help/install.txt @@ -22,6 +22,7 @@ Flags for install: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/list-bin.txt b/doc/cmd-v2-help/list-bin.txt index 4813a871a17..21102d2a7de 100644 --- a/doc/cmd-v2-help/list-bin.txt +++ b/doc/cmd-v2-help/list-bin.txt @@ -13,6 +13,7 @@ Flags for list-bin: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/outdated.txt b/doc/cmd-v2-help/outdated.txt index 7c8ac302dde..7a62323c881 100644 --- a/doc/cmd-v2-help/outdated.txt +++ b/doc/cmd-v2-help/outdated.txt @@ -14,6 +14,7 @@ Flags for outdated: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/path.txt b/doc/cmd-v2-help/path.txt index 85d6a0fcf66..e03f48cee79 100644 --- a/doc/cmd-v2-help/path.txt +++ b/doc/cmd-v2-help/path.txt @@ -15,6 +15,7 @@ Flags for path: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/repl.txt b/doc/cmd-v2-help/repl.txt index 7a8d67a106d..05db7aaa80f 100644 --- a/doc/cmd-v2-help/repl.txt +++ b/doc/cmd-v2-help/repl.txt @@ -24,6 +24,7 @@ Flags for repl: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/run.txt b/doc/cmd-v2-help/run.txt index 315e1f8ec1f..f227266a059 100644 --- a/doc/cmd-v2-help/run.txt +++ b/doc/cmd-v2-help/run.txt @@ -27,6 +27,7 @@ Flags for run: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/target.txt b/doc/cmd-v2-help/target.txt index 7ee4373a095..cb671280da9 100644 --- a/doc/cmd-v2-help/target.txt +++ b/doc/cmd-v2-help/target.txt @@ -43,6 +43,7 @@ Flags for target: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/test.txt b/doc/cmd-v2-help/test.txt index 5011fa949e6..79004cce3c4 100644 --- a/doc/cmd-v2-help/test.txt +++ b/doc/cmd-v2-help/test.txt @@ -23,6 +23,7 @@ Flags for test: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/cmd-v2-help/update.txt b/doc/cmd-v2-help/update.txt index ff6cdee8feb..b830776bb4b 100644 --- a/doc/cmd-v2-help/update.txt +++ b/doc/cmd-v2-help/update.txt @@ -13,6 +13,7 @@ Flags for update: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool diff --git a/doc/config.rst b/doc/config.rst index 59a61685de9..b845acb604e 100644 --- a/doc/config.rst +++ b/doc/config.rst @@ -356,6 +356,8 @@ The list of known programs is: +-----------------------+------------------------------------------------------------------------------------------------------------------------------------+ | ``ld`` | Usually provided by GHC's ``"ld command"`` entry in ``ghc --info``. | +-----------------------+------------------------------------------------------------------------------------------------------------------------------------+ +| ``mhs`` | ``_ | ++-----------------------+------------------------------------------------------------------------------------------------------------------------------------+ | ``pkg-config`` | Used to find the dependencies listed in :pkg-field:`pkgconfig-depends`, see the | | | `pkg-config homepage `_. | +-----------------------+------------------------------------------------------------------------------------------------------------------------------------+ diff --git a/doc/setup-commands.rst b/doc/setup-commands.rst index 2fbefc441a1..458d48a3130 100644 --- a/doc/setup-commands.rst +++ b/doc/setup-commands.rst @@ -168,6 +168,7 @@ files of a package: .. option:: -g, --ghc --uhc + --mhs Specify which Haskell implementation to use to build the package. At most one of these flags may be given. If none is given, the @@ -202,7 +203,8 @@ files of a package: programs is as follows: ``alex``, ``ar``, ``c2hs``, ``cpphs``, ``doctest``, ``gcc``, ``ghc``, ``ghc-pkg``, ``haddock``, ``happy``, ``hpc``, ``hsc2hs``, ``hscolour``, - ``jhc``, ``ld``, ``pkg-config``, ``runghc``, ``strip``, ``tar``, ``uhc``. + ``jhc``, ``ld``, ``mhs``, ``pkg-config``, ``runghc``, ``strip``, ``tar``, + ``uhc``. .. option:: --PROG-options=OPTS diff --git a/doc/setup-help/build.txt b/doc/setup-help/build.txt index e2fa52204a8..0bd44a09a49 100644 --- a/doc/setup-help/build.txt +++ b/doc/setup-help/build.txt @@ -31,4 +31,4 @@ Examples: The flags --with-PROG and --PROG-option(s) can be used with the following programs: alex ar c2hs cpphs doctest gcc ghc ghc-pkg haddock happy hpc hsc2hs hscolour - jhc ld pkg-config runghc strip tar uhc + jhc ld mhs pkg-config runghc strip tar uhc diff --git a/doc/setup-help/configure.txt b/doc/setup-help/configure.txt index 4d89ab66c29..6c3889e37df 100644 --- a/doc/setup-help/configure.txt +++ b/doc/setup-help/configure.txt @@ -17,6 +17,7 @@ Flags for configure: --keep-temp-files # Keep temporary files. -g, --ghc # Compile with GHC --uhc # Compile with UHC + --mhs # Compile with MHS -w PATH or -wPATH, --with-compiler=PATH # Give the path to a particular compiler --with-hc-pkg=PATH # Give the path to the package tool @@ -192,4 +193,4 @@ Flags for configure: The flags --with-PROG and --PROG-option(s) can be used with the following programs: alex ar c2hs cpphs doctest gcc ghc ghc-pkg haddock happy hpc hsc2hs hscolour - jhc ld pkg-config runghc strip tar uhc + jhc ld mhs pkg-config runghc strip tar uhc From 2b2f1e729364457b34728b81d7592be6d2bed02b Mon Sep 17 00:00:00 2001 From: Artem Pelenitsyn Date: Mon, 12 Oct 2026 14:58:45 -0400 Subject: [PATCH 2/6] Present the base of mhs at its Hackage versions The base of mhs is versioned like the compiler (base-0.16.9.0) and bundles the modules of packages that are separate on Hackage: bytestring, text, deepseq, stm, directory, process, hashable and integer-logarithms. A package written for GHC depends on base-4.x and on those packages by name, so it cannot be solved against what mhs provides: the only installed base is 0.16.9.0, and base is not reinstallable. Describe the base of mhs the way MicroCabal does, with the versions from its builtinPackages table ("totally fake; they are from GHC"): base at 4.19.1.0, and the bundled packages as installed packages of their own, at the versions MicroCabal gives them, depending on base, with the modules that are theirs and no package file. The unit id of base stays base-0.16.9.0, which is also the name of its package file, so the dependency closure of a component still preloads the one base.pkg. A package file is now looked up under the unit id first, then under the munged package id of a library built by Cabal, and a package without library directories has nothing to load. Only hashable gets a version of its own. MicroCabal has it at 1.0.0.0, "very rudimentary", which makes no difference to it, as it does not check bounds. But the Data.Hashable of mhs has the API of the 1.4 series (Data.Hashable.Lifted, Hashable1 with an Eq1 superclass), and the packages that depend on hashable require at least that: unordered-containers 1.4, these 1.4.4. With 1.0.0.0, the solver built hashable-1.5.1.0 from Hackage for them instead, which mhs cannot compile, so hashable is presented at 1.4.7.0. A base that Cabal registered, built from the sources of MicroHs, is presented the same way as the one that comes with mhs; its package file keeps the name it was built under, which its registration records as its compat package key, and is found by it. A library without modules, which Cabal registers with its extra-lib-dirs as its library directories, has no package file to load there; its linker options come from its registration. Tested with mhs 0.16.9.0: a library with 'base ^>=4.19, bytestring >=0.11' and an executable with 'base >=4.14 && <5' solve, build and run, with only base.pkg preloaded; the testsuite package has such bounds now. Co-Authored-By: Claude Fable 5.1 Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_0176vAefrw8jPKXdh9h1wKuj --- Cabal/src/Distribution/Simple/MHS.hs | 160 ++++++++++++++---- .../PackageTests/MHS/mhs-test.cabal | 4 +- .../PackageTests/MHS/src/Greeting/Internal.hs | 4 +- changelog.d/pr-11392.md | 6 + 4 files changed, 137 insertions(+), 37 deletions(-) diff --git a/Cabal/src/Distribution/Simple/MHS.hs b/Cabal/src/Distribution/Simple/MHS.hs index 336c6f3e8ca..d16701a1315 100644 --- a/Cabal/src/Distribution/Simple/MHS.hs +++ b/Cabal/src/Distribution/Simple/MHS.hs @@ -96,6 +96,16 @@ installs packages for the user. The packages of these directories have no registration file: they are described by what 'mhs -L' reports about them, with - as their unit id. A directory given as SpecificPackageDB may hold such packages too. + +The base of mhs is versioned like mhs itself (base-0.16.9.0, say), and it +bundles the modules of packages that are separate on Hackage: bytestring, +text, deepseq, stm, directory, process, hashable and integer-logarithms. +Packages from Hackage depend on base-4.x and on those packages by name, so +Cabal describes the base of mhs the way MicroCabal does: as base at a GHC-era +version, and the bundled packages as installed packages of their own that +depend on base and have no package file, so that base.pkg is what gets +loaded. See 'compatPackages'. The unit id of base stays - as +mhs knows it, which is also the name of its package file. -} -- ----------------------------------------------------------------------------- @@ -231,13 +241,16 @@ userPackageDbDir comp = do -- See Note [MicroHs package databases]. readPackageDbDir :: Verbosity -> ProgramDb -> FilePath -> IO [InstalledPackageInfo] readPackageDbDir verbosity progdb dir = do - registered <- traverse (readRegistrationFile verbosity) =<< filesWithExtension ".conf" dir - let registeredPkgFiles = map mhsPackageFileName registered + raw <- traverse (readRegistrationFile verbosity) =<< filesWithExtension ".conf" dir + let registeredPkgFiles = map mhsPackageFileName raw + -- A base that Cabal registered, built from the sources of MicroHs, is + -- the base of mhs as much as the one that comes with it. + registered = concatMap withCompat raw pkgFiles <- filesWithExtension ".pkg" (dir "packages") unregistered <- traverse (describePackageFile verbosity progdb) $ [pkgFile | pkgFile <- pkgFiles, takeFileName pkgFile `notElem` registeredPkgFiles] - return (registered ++ catMaybes unregistered) + return (registered ++ concat unregistered) -- | The paths of the files with the given extension in a directory, if the -- directory exists. @@ -273,7 +286,9 @@ readRegistrationFile verbosity file = do -- > ... -- > other-modules: -- > ... -describePackageFile :: Verbosity -> ProgramDb -> FilePath -> IO (Maybe InstalledPackageInfo) +-- +-- The base of mhs is described as several packages, see 'compatPackages'. +describePackageFile :: Verbosity -> ProgramDb -> FilePath -> IO [InstalledPackageInfo] describePackageFile verbosity progdb pkgFile = do output <- getDbProgramOutput verbosity mhsProgram progdb ["-L" ++ pkgFile] let fields = parseFields output @@ -286,24 +301,24 @@ describePackageFile verbosity progdb pkgFile = do let MungedPackageName pname libname = decodeCompatPackageName (mkPackageName name) pkgId = PackageIdentifier pname version unitId = mkUnitId (mhsPackageId pkgId libname) - return $ - Just - emptyInstalledPackageInfo - { IPI.sourcePackageId = pkgId - , IPI.sourceLibName = libname - , IPI.installedUnitId = unitId - , IPI.installedComponentId_ = mkComponentId (unUnitId unitId) - , IPI.exposed = True - , IPI.exposedModules = [ExposedModule m Nothing | m <- modules "exposed-modules"] - , IPI.hiddenModules = modules "other-modules" - , IPI.depends = map mkUnitId (field "depends") - , IPI.libraryDirs = [takeDirectory pkgFile] - , IPI.ldOptions = field "linker opts" - } + pkg = + emptyInstalledPackageInfo + { IPI.sourcePackageId = pkgId + , IPI.sourceLibName = libname + , IPI.installedUnitId = unitId + , IPI.installedComponentId_ = mkComponentId (unUnitId unitId) + , IPI.exposed = True + , IPI.exposedModules = [ExposedModule m Nothing | m <- modules "exposed-modules"] + , IPI.hiddenModules = modules "other-modules" + , IPI.depends = map mkUnitId (field "depends") + , IPI.libraryDirs = [takeDirectory pkgFile] + , IPI.ldOptions = field "linker opts" + } + return (withCompat pkg) _ -> do warn verbosity $ "Ignoring the MicroHs package file " ++ pkgFile ++ ", which mhs cannot describe." - return Nothing + return [] -- | Parse the fields of what @mhs -L@ reports: a @name: value@ line -- starts a field, and the indented lines that follow continue it. The value @@ -321,28 +336,105 @@ parseFields = go . lines isIndented (c : _) = isSpace c isIndented [] = False +-- | The version at which the base of mhs is presented, and the packages of +-- Hackage whose modules it bundles, with the version at which each is +-- presented and the modules (given by prefix) that are theirs. +-- +-- The versions are those that MicroCabal uses for the same purpose; in its +-- words, "the version numbers are totally fake; they are from GHC". They say +-- which API the modules roughly implement. The exception is hashable, which +-- MicroCabal has at 1.0.0.0, "very rudimentary": the Data.Hashable of mhs has +-- the API of the 1.4 series (Data.Hashable.Lifted, Hashable1 with an Eq1 +-- superclass), and the packages that depend on hashable require at least that +-- (unordered-containers 1.4, these 1.4.4), which MicroCabal can ignore, as it +-- does not check bounds, but Cabal cannot. +baseCompatVersion :: Version +baseCompatVersion = mkVersion [4, 19, 1, 0] + +bundledPackages :: [(String, [Int], [String])] +bundledPackages = + [ ("bytestring", [0, 12, 1, 0], ["Data.ByteString"]) + , ("deepseq", [1, 4, 4, 0], ["Control.DeepSeq"]) + , ("directory", [1, 3, 8, 1], ["System.Directory"]) + , ("hashable", [1, 4, 7, 0], ["Data.Hashable"]) + , ("integer-logarithms", [1, 0, 4], ["Math.NumberTheory"]) + , ("process", [1, 6, 18, 0], ["System.Process"]) + , ("stm", [2, 5, 3, 0], ["Control.Concurrent.STM", "Control.Monad.STM"]) + , ("text", [2, 1, 1], ["Data.Text"]) + ] + +-- | The packages that an installed package is presented as: the base of mhs +-- as 'compatPackages', any other package as itself. +withCompat :: InstalledPackageInfo -> [InstalledPackageInfo] +withCompat ipi + | pkgName (IPI.sourcePackageId ipi) == mkPackageName "base" && IPI.sourceLibName ipi == LMainLibName = compatPackages ipi + | otherwise = [ipi] + +-- | Present the base of mhs the way packages from Hackage expect it: at +-- 'baseCompatVersion', and with the 'bundledPackages' as installed packages +-- of their own, which depend on base and have no package file of their own. +-- See Note [MicroHs package databases]. +compatPackages :: InstalledPackageInfo -> [InstalledPackageInfo] +compatPackages base = + base + { IPI.sourcePackageId = PackageIdentifier (packageName base) baseCompatVersion + , IPI.exposedModules = [m | m <- IPI.exposedModules base, not (any (bundles m) prefixesOf)] + } + : [ emptyInstalledPackageInfo + { IPI.sourcePackageId = pkgId + , IPI.installedUnitId = mkUnitId (prettyShow pkgId) + , IPI.installedComponentId_ = mkComponentId (prettyShow pkgId) + , IPI.exposed = True + , IPI.exposedModules = [m | m <- IPI.exposedModules base, bundles m prefixes] + , IPI.depends = [IPI.installedUnitId base] + } + | (name, version, prefixes) <- bundledPackages + , let pkgId = PackageIdentifier (mkPackageName name) (mkVersion version) + ] + where + prefixesOf = [prefixes | (_, _, prefixes) <- bundledPackages] + bundles (ExposedModule m _) prefixes = + any (\root -> moduleName == root || (root ++ ".") `isPrefixOf` moduleName) prefixes + where + moduleName = prettyShow m + -- | The name under which mhs knows a library: @-@, with the -- munged name of the library, so that the sub-libraries of a package get -- distinct names. mhsPackageId :: PackageId -> LibraryName -> String mhsPackageId pkgId libname = prettyShow (computeCompatPackageId pkgId libname) --- | The name of the package file of a library, @-.pkg@. +-- | The name of the package file of a library built by Cabal, +-- @-.pkg@. mhsPackageFileName :: InstalledPackageInfo -> FilePath mhsPackageFileName ipi = mhsPackageId (IPI.sourcePackageId ipi) (IPI.sourceLibName ipi) <.> "pkg" --- | The package file of a library, in one of its library directories; none if --- the library has no modules and mhs hence nothing to load. +-- | The package file of a library, in one of its library directories: named +-- after its unit id for a package that comes with mhs, see +-- 'describePackageFile', and after its munged package id for a library built +-- by Cabal, see 'buildLib', as it was built: the compat package key of its +-- registration, which is the name and version Cabal built it at, even when +-- it is presented at another version, see 'compatPackages'. A library +-- without library directories has no +-- package file: it has no modules, or mhs provides it as part of base, see +-- 'compatPackages'. A library without modules is registered with its +-- extra-lib-dirs as its library directories, where its package file is not: +-- its linker options are taken from its registration instead, see 'runMhs'. packageFile :: Verbosity -> InstalledPackageInfo -> IO (Maybe FilePath) -packageFile verbosity ipi = do - let fileName = mhsPackageFileName ipi - dirs = IPI.libraryDirs ipi - mbFile <- findFirstFile id [dir fileName | dir <- dirs] - case mbFile of - Just file -> return (Just file) - Nothing - | null (IPI.exposedModules ipi) && null (IPI.hiddenModules ipi) -> return Nothing - | otherwise -> dieWithException verbosity $ MhsPackageFileNotFound fileName dirs +packageFile verbosity ipi + | null dirs = return Nothing + | otherwise = do + mbFile <- findFirstFile id [dir file | dir <- dirs, file <- files] + when (isNothing mbFile && not (null (IPI.exposedModules ipi) && null (IPI.hiddenModules ipi))) $ + dieWithException verbosity $ + MhsPackageFileNotFound (IPI.installedUnitId ipi) dirs + return mbFile + where + dirs = IPI.libraryDirs ipi + files = + ordNub $ + [unUnitId (IPI.installedUnitId ipi) <.> "pkg", mhsPackageFileName ipi] + ++ [IPI.compatPackageKey ipi <.> "pkg" | not (null (IPI.compatPackageKey ipi))] -- ----------------------------------------------------------------------------- -- Building @@ -573,7 +665,7 @@ registerPackage verbosity mbWorkDir comp progdb packageDbs installedPkgInfo = do -- | The errors of building with MicroHs. data MhsException = MhsNoGlobalPackageDb - | MhsPackageFileNotFound FilePath [FilePath] + | MhsPackageFileNotFound UnitId [FilePath] | MhsRegistrationFileParseError FilePath [String] | MhsMissingDependencies [UnitId] | MhsRenamedReexports [ModuleReexport] @@ -596,8 +688,8 @@ mhsExceptionMessage :: MhsException -> String mhsExceptionMessage err = case err of MhsNoGlobalPackageDb -> "mhs does not report a package directory to register the package in (see 'mhs -L')." - MhsPackageFileNotFound pkgFile dirs -> - "Cannot find the MicroHs package file " ++ pkgFile ++ " in " ++ intercalate ", " dirs + MhsPackageFileNotFound unitId dirs -> + "Cannot find the MicroHs package file of " ++ prettyShow unitId ++ " in " ++ intercalate ", " dirs MhsRegistrationFileParseError file errs -> "Failed to parse the package registration file " ++ file ++ ":\n" ++ unlines errs MhsMissingDependencies unitIds -> diff --git a/cabal-testsuite/PackageTests/MHS/mhs-test.cabal b/cabal-testsuite/PackageTests/MHS/mhs-test.cabal index 71ba6cb6200..4a20d0d12c1 100644 --- a/cabal-testsuite/PackageTests/MHS/mhs-test.cabal +++ b/cabal-testsuite/PackageTests/MHS/mhs-test.cabal @@ -8,12 +8,12 @@ synopsis: A package to build with MicroHs library exposed-modules: Greeting other-modules: Greeting.Internal - build-depends: base + build-depends: base >=4.14 && <5, bytestring >=0.11 hs-source-dirs: src default-language: Haskell2010 executable mhs-test main-is: Main.hs - build-depends: base, mhs-test + build-depends: base ^>=4.19, mhs-test hs-source-dirs: app default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/MHS/src/Greeting/Internal.hs b/cabal-testsuite/PackageTests/MHS/src/Greeting/Internal.hs index 98c92da6ae5..4b0e2a7c52b 100644 --- a/cabal-testsuite/PackageTests/MHS/src/Greeting/Internal.hs +++ b/cabal-testsuite/PackageTests/MHS/src/Greeting/Internal.hs @@ -1,4 +1,6 @@ module Greeting.Internal (compilerName) where +import qualified Data.ByteString.Char8 as B + compilerName :: String -compilerName = "MicroHs" +compilerName = B.unpack (B.pack "MicroHs") diff --git a/changelog.d/pr-11392.md b/changelog.d/pr-11392.md index 62684547999..9746e533edb 100644 --- a/changelog.d/pr-11392.md +++ b/changelog.d/pr-11392.md @@ -17,6 +17,12 @@ packages it depends on. Only what simple packages need is implemented; there is no support for Backpack, foreign libraries, profiling, shared libraries or C sources in libraries. +The `base` of mhs is versioned like mhs itself and bundles the modules of +`bytestring`, `text`, `deepseq`, `stm`, `directory`, `process`, `hashable` and +`integer-logarithms`. So that packages written for GHC solve, Cabal presents it +as `base-4.19.1.0` and the bundled packages as installed packages of their +own, at the versions MicroCabal uses for the same purpose. + Since mhs ignores the `LANGUAGE` pragmas of the extensions it does not implement, packages are not rejected for the extensions they declare, and `reexported-modules` are accepted, as mhs sees all the modules of the From 48f2e338b9c4f7b4b322a9497f1416838745cda5 Mon Sep 17 00:00:00 2001 From: Artem Pelenitsyn Date: Mon, 12 Oct 2026 18:54:12 -0400 Subject: [PATCH 3/6] Pass the version macros of cabal_macros.h to mhs GHC includes cabal_macros.h with -optP-include. mhs passes on to cpphs only the -D and -I options it is given, so give it the macros of the header one by one, as MicroCabal does. Distribution.Simple.MHS turns every #define of the header that generateCabalMacrosHeader renders, which is unchanged, into a -D option: VERSION_ and MIN_VERSION_(major1,major2,minor) for the package and its dependencies, the TOOL_ variants for the configured programs, and the CURRENT_ constants, the first definition of a macro winning as in the header. The autogen directory of the component is on the include path of cpphs too, so a module that includes cabal_macros.h itself finds it. Many packages choose code on these macros, transformers for instance its Semigroup instances, and without them took the branch for an ancient base. The test of mhs moves to PackageTests/MHS/Build, and PackageTests/MHS/Macros checks the macros; it is skipped unless mhs and its cpphs are installed. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_0176vAefrw8jPKXdh9h1wKuj --- Cabal/src/Distribution/Simple/MHS.hs | 43 ++++++++++++++++--- .../PackageTests/MHS/{ => Build}/app/Main.hs | 0 .../MHS/{ => Build}/cabal.project | 0 .../MHS/{ => Build}/cabal.test.hs | 0 .../MHS/{ => Build}/mhs-test.cabal | 0 .../MHS/{ => Build}/src/Greeting.hs | 0 .../MHS/{ => Build}/src/Greeting/Internal.hs | 0 .../PackageTests/MHS/Macros/app/Main.hs | 15 +++++++ .../PackageTests/MHS/Macros/cabal.project | 3 ++ .../PackageTests/MHS/Macros/cabal.test.hs | 15 +++++++ .../PackageTests/MHS/Macros/mhs-macros.cabal | 18 ++++++++ .../PackageTests/MHS/Macros/src/Versions.hs | 29 +++++++++++++ changelog.d/pr-11392.md | 3 +- 13 files changed, 120 insertions(+), 6 deletions(-) rename cabal-testsuite/PackageTests/MHS/{ => Build}/app/Main.hs (100%) rename cabal-testsuite/PackageTests/MHS/{ => Build}/cabal.project (100%) rename cabal-testsuite/PackageTests/MHS/{ => Build}/cabal.test.hs (100%) rename cabal-testsuite/PackageTests/MHS/{ => Build}/mhs-test.cabal (100%) rename cabal-testsuite/PackageTests/MHS/{ => Build}/src/Greeting.hs (100%) rename cabal-testsuite/PackageTests/MHS/{ => Build}/src/Greeting/Internal.hs (100%) create mode 100644 cabal-testsuite/PackageTests/MHS/Macros/app/Main.hs create mode 100644 cabal-testsuite/PackageTests/MHS/Macros/cabal.project create mode 100644 cabal-testsuite/PackageTests/MHS/Macros/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/MHS/Macros/mhs-macros.cabal create mode 100644 cabal-testsuite/PackageTests/MHS/Macros/src/Versions.hs diff --git a/Cabal/src/Distribution/Simple/MHS.hs b/Cabal/src/Distribution/Simple/MHS.hs index d16701a1315..ef9fe018c34 100644 --- a/Cabal/src/Distribution/Simple/MHS.hs +++ b/Cabal/src/Distribution/Simple/MHS.hs @@ -47,6 +47,7 @@ import Distribution.Package hiding (installedUnitId) import Distribution.PackageDescription import Distribution.Parsec (simpleParsec) import Distribution.Pretty +import Distribution.Simple.Build.Macros (generateCabalMacrosHeader) import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler import Distribution.Simple.LocalBuildInfo @@ -63,6 +64,7 @@ import Distribution.Version import Language.Haskell.Extension import qualified Data.ByteString as BS +import Data.List (stripPrefix) import qualified Data.Map as Map (fromList) import qualified Data.Text as Text import System.Directory (doesDirectoryExist, getDirectoryContents, getHomeDirectory, makeAbsolute) @@ -465,7 +467,7 @@ buildLib verbosity pkg_descr lbi lib clbi = do createDirectoryIfMissingVerbose verbosity True (interpretSymbolicPathLBI lbi targetDir) unless (null (cSources bi)) $ warn verbosity "MicroHs cannot include C sources in a library; ignoring them." - runMhs verbosity lbi bi clbi targetDir $ + runMhs verbosity pkg_descr lbi bi clbi targetDir $ ["-P" ++ pkgId, "-o", interpretSymbolicPathCWD pkgFile] ++ map prettyShow modules @@ -476,7 +478,7 @@ buildExe -> Executable -> ComponentLocalBuildInfo -> IO () -buildExe verbosity _pkg_descr lbi exe clbi = do +buildExe verbosity pkg_descr lbi exe clbi = do let bi = buildInfo exe exeName' = prettyShow (exeName exe) targetDir = buildDir lbi makeRelativePathEx exeName' @@ -488,7 +490,7 @@ buildExe verbosity _pkg_descr lbi exe clbi = do srcMainPath <- findFileCwd verbosity (mbWorkDirLBI lbi) (coerceSymbolicPath generatedDir : sourceDirs bi) (modulePath exe) createDirectoryIfMissingVerbose verbosity True (interpretSymbolicPathLBI lbi targetDir) - runMhs verbosity lbi bi clbi generatedDir $ + runMhs verbosity pkg_descr lbi bi clbi generatedDir $ -- Compress the combinator code of the program, as MicroCabal does. ["-z"] ++ map u (cSources bi) @@ -498,6 +500,7 @@ buildExe verbosity _pkg_descr lbi exe clbi = do -- by the given ones. runMhs :: Verbosity + -> PackageDescription -> LocalBuildInfo -> BuildInfo -> ComponentLocalBuildInfo @@ -505,7 +508,7 @@ runMhs -- ^ where the preprocessors put the modules they generated -> [String] -> IO () -runMhs verbosity lbi bi clbi generatedDir args = do +runMhs verbosity pkg_descr lbi bi clbi generatedDir args = do let comp = compiler lbi mbWorkDir = mbWorkDirLBI lbi progdb = withPrograms lbi @@ -532,10 +535,14 @@ runMhs verbosity lbi bi clbi generatedDir args = do ++ ["-p" ++ pkgFile | pkgFile <- pkgFiles] ++ languageToFlags comp (defaultLanguage bi) ++ extensionsToFlags comp (usedExtensions bi) + -- mhs passes only -D and -I options on to cpphs, so the macros of + -- cabal_macros.h are defined one by one rather than included. The + -- header is found for the modules that include it themselves. + ++ cabalMacrosOptions pkg_descr lbi clbi + ++ ["-I" ++ u (autogenComponentModulesDir lbi clbi)] -- The headers that hsc2hs generates beside the modules, for the C -- it generates with them. ++ ["-I" ++ u generatedDir] - -- mhs passes only -D and -I options on to cpphs. ++ [opt | opt <- map Text.unpack (cppOptions bi), any (`isPrefixOf` opt) ["-D", "-I"]] ++ ["-I" ++ u dir | dir <- includeDirs bi] ++ map Text.unpack (hcOptions MHS bi) @@ -570,6 +577,32 @@ dependencyPackageFiles verbosity lbi clbi = do where deps = map fst (componentPackageDeps clbi) +-- | The macros of @cabal_macros.h@ as @-D@ options of cpphs, to which mhs passes +-- on only the @-D@ and @-I@ options it is given, so that it cannot be told to +-- include the header: every @#define@ of the header, with its continuation +-- lines joined, becomes an option, and the first definition of a macro wins, +-- as the @#ifndef@ guards of the header make it. +cabalMacrosOptions :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> [String] +cabalMacrosOptions pkg_descr lbi clbi = + [ "-D" ++ lhs ++ "=" ++ rhs + | (_, lhs, rhs) <- ordNubBy (\(name, _, _) -> name) defines + ] + where + header = generateCabalMacrosHeader pkg_descr lbi clbi + defines = + [ (takeWhile (/= '(') lhs, lhs, dropWhile isSpace rhs) + | line <- joinContinuations (lines header) + , Just definition <- [stripPrefix "#define " line] + , let (lhs, rhs) = break isSpace definition + ] + joinContinuations (line : rest) + | '\\' : reversedLine <- reverse line = + case joinContinuations rest of + next : rest' -> (reverse reversedLine ++ next) : rest' + [] -> [reverse reversedLine] + | otherwise = line : joinContinuations rest + joinContinuations [] = [] + -- | The source directories of a component; the package directory if none are -- given. sourceDirs :: BuildInfo -> [SymbolicPath Pkg (Dir Source)] diff --git a/cabal-testsuite/PackageTests/MHS/app/Main.hs b/cabal-testsuite/PackageTests/MHS/Build/app/Main.hs similarity index 100% rename from cabal-testsuite/PackageTests/MHS/app/Main.hs rename to cabal-testsuite/PackageTests/MHS/Build/app/Main.hs diff --git a/cabal-testsuite/PackageTests/MHS/cabal.project b/cabal-testsuite/PackageTests/MHS/Build/cabal.project similarity index 100% rename from cabal-testsuite/PackageTests/MHS/cabal.project rename to cabal-testsuite/PackageTests/MHS/Build/cabal.project diff --git a/cabal-testsuite/PackageTests/MHS/cabal.test.hs b/cabal-testsuite/PackageTests/MHS/Build/cabal.test.hs similarity index 100% rename from cabal-testsuite/PackageTests/MHS/cabal.test.hs rename to cabal-testsuite/PackageTests/MHS/Build/cabal.test.hs diff --git a/cabal-testsuite/PackageTests/MHS/mhs-test.cabal b/cabal-testsuite/PackageTests/MHS/Build/mhs-test.cabal similarity index 100% rename from cabal-testsuite/PackageTests/MHS/mhs-test.cabal rename to cabal-testsuite/PackageTests/MHS/Build/mhs-test.cabal diff --git a/cabal-testsuite/PackageTests/MHS/src/Greeting.hs b/cabal-testsuite/PackageTests/MHS/Build/src/Greeting.hs similarity index 100% rename from cabal-testsuite/PackageTests/MHS/src/Greeting.hs rename to cabal-testsuite/PackageTests/MHS/Build/src/Greeting.hs diff --git a/cabal-testsuite/PackageTests/MHS/src/Greeting/Internal.hs b/cabal-testsuite/PackageTests/MHS/Build/src/Greeting/Internal.hs similarity index 100% rename from cabal-testsuite/PackageTests/MHS/src/Greeting/Internal.hs rename to cabal-testsuite/PackageTests/MHS/Build/src/Greeting/Internal.hs diff --git a/cabal-testsuite/PackageTests/MHS/Macros/app/Main.hs b/cabal-testsuite/PackageTests/MHS/Macros/app/Main.hs new file mode 100644 index 00000000000..dea176d8883 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/Macros/app/Main.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE CPP #-} + +module Main (main) where + +-- The header itself, for the modules that include it, is found too. +#include "cabal_macros.h" + +import Versions (versions) + +main :: IO () +main = do + mapM_ putStrLn versions +#if MIN_VERSION_mhs_macros(1,0,0) + putStrLn ("library " ++ VERSION_mhs_macros) +#endif diff --git a/cabal-testsuite/PackageTests/MHS/Macros/cabal.project b/cabal-testsuite/PackageTests/MHS/Macros/cabal.project new file mode 100644 index 00000000000..3dccaec797b --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/Macros/cabal.project @@ -0,0 +1,3 @@ +packages: . +compiler: mhs +with-compiler: mhs diff --git a/cabal-testsuite/PackageTests/MHS/Macros/cabal.test.hs b/cabal-testsuite/PackageTests/MHS/Macros/cabal.test.hs new file mode 100644 index 00000000000..a6500d5e6ed --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/Macros/cabal.test.hs @@ -0,0 +1,15 @@ +import Test.Cabal.Prelude + +-- The version macros of cabal_macros.h with MicroHs, if it is installed with +-- cpphs, which it runs for CPP. +main = cabalTest $ do + skipUnless "no mhs" =<< isAvailableProgram mhsProgram + skipUnless "no cpphs" =<< isAvailableProgram cpphsProgram + recordMode DoNotRecord $ do + cabal "v2-build" ["all"] + out <- cabal' "v2-run" ["mhs-macros"] + assertOutputContains "base 4.19.1.0" out + assertOutputContains "bytestring 0.12.1.0" out + assertOutputContains "package 1.0" out + assertOutputContains "tool mhs" out + assertOutputContains "library 1.0" out diff --git a/cabal-testsuite/PackageTests/MHS/Macros/mhs-macros.cabal b/cabal-testsuite/PackageTests/MHS/Macros/mhs-macros.cabal new file mode 100644 index 00000000000..49e26685df8 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/Macros/mhs-macros.cabal @@ -0,0 +1,18 @@ +cabal-version: 3.0 +name: mhs-macros +version: 1.0 +build-type: Simple +license: BSD-3-Clause +synopsis: The version macros of cabal_macros.h with MicroHs + +library + exposed-modules: Versions + build-depends: base >=4.14 && <5, bytestring >=0.11 + hs-source-dirs: src + default-language: Haskell2010 + +executable mhs-macros + main-is: Main.hs + build-depends: base, mhs-macros + hs-source-dirs: app + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/MHS/Macros/src/Versions.hs b/cabal-testsuite/PackageTests/MHS/Macros/src/Versions.hs new file mode 100644 index 00000000000..9422824ac17 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/Macros/src/Versions.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE CPP #-} + +-- | The versions that the macros of cabal_macros.h give, which Cabal passes to +-- mhs as -D options. +module Versions (versions) where + +versions :: [String] +versions = [base, bytestring, "package " ++ CURRENT_PACKAGE_VERSION, tool] + +base :: String +#if MIN_VERSION_base(4,19,0) && !MIN_VERSION_base(5,0,0) +base = "base " ++ VERSION_base +#else +base = "MIN_VERSION_base is missing or wrong" +#endif + +bytestring :: String +#if MIN_VERSION_bytestring(0,11,0) +bytestring = "bytestring " ++ VERSION_bytestring +#else +bytestring = "MIN_VERSION_bytestring is missing or wrong" +#endif + +tool :: String +#if defined(MIN_TOOL_VERSION_mhs) +tool = "tool mhs" +#else +tool = "MIN_TOOL_VERSION_mhs is missing" +#endif diff --git a/changelog.d/pr-11392.md b/changelog.d/pr-11392.md index 9746e533edb..04e91600d37 100644 --- a/changelog.d/pr-11392.md +++ b/changelog.d/pr-11392.md @@ -26,4 +26,5 @@ own, at the versions MicroCabal uses for the same purpose. Since mhs ignores the `LANGUAGE` pragmas of the extensions it does not implement, packages are not rejected for the extensions they declare, and `reexported-modules` are accepted, as mhs sees all the modules of the -packages it loads, unless they rename modules, which mhs cannot do. +packages it loads, unless they rename modules, which mhs cannot do. The macros of `cabal_macros.h`, such as `MIN_VERSION_base`, +are passed to mhs as `-D` options of its preprocessor. From d918f3181d80183a275811ceafcfaf7fc9c21c41 Mon Sep 17 00:00:00 2001 From: Artem Pelenitsyn Date: Tue, 13 Oct 2026 03:04:26 -0400 Subject: [PATCH 4/6] Rewrite packages for mhs as MicroCabal does, before solving MicroCabal rewrites the dependencies of every package it builds with mhs: it adds ghc-compat, which holds modules that are part of base in GHC but not in mhs, such as GHC.Stack and Language.Haskell.TH.Syntax, and it uses the forks array-mhs and random-mhs instead of array and random, which mhs cannot compile. Packages written for GHC rely on both. Distribution.Simple.MHS.rewritePackageDescription does the same, and cabal-install applies it to all the packages it gives to the solver (rewriteSourcePackages, next to the rewriting for allow-newer), so that the solver chooses ghc-compat and the forks, and cabal-install builds them from Hackage like any other dependency. Nothing has to be installed for mhs beforehand, and offline, where they cannot be had, the packages are left as they are. ghc-compat is added at the root of every component, unless the component depends on it there already, with bounds of its own; a dependency under a condition, or in another component, is no reason to leave it out. A re-export that names the package of a module, array:Data.Array say, names the fork too, as Cabal resolves it by that name. See Note [MicroHs rewrites of packages]. Rewriting the packages before solving is enough thanks to a recent change of cabal-install, which calls Cabal in-library (#11703): it configures a package with the description of its plan, which is rewritten already, rather than having a Setup script read the .cabal file of the package again. Before that change, configure had to rewrite the package once more. Only a Custom setup script still reads the .cabal file, and mhs cannot compile one. As with MicroCabal, the version macros of a fork are also defined under the name of the package it forks: QuickCheck, which depends on random, tests MIN_VERSION_random(1,3,0) to define its RandomGen instance. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_0176vAefrw8jPKXdh9h1wKuj --- Cabal/src/Distribution/Simple/MHS.hs | 106 +++++++++++++++++- .../src/Distribution/Client/Dependency.hs | 24 +++- .../Distribution/Client/ProjectPlanning.hs | 1 + changelog.d/pr-11392.md | 6 +- 4 files changed, 133 insertions(+), 4 deletions(-) diff --git a/Cabal/src/Distribution/Simple/MHS.hs b/Cabal/src/Distribution/Simple/MHS.hs index ef9fe018c34..1ea9e58ae32 100644 --- a/Cabal/src/Distribution/Simple/MHS.hs +++ b/Cabal/src/Distribution/Simple/MHS.hs @@ -29,6 +29,7 @@ module Distribution.Simple.MHS , installExe , createPackageDB , registerPackage + , rewritePackageDescription ) where import Distribution.Compat.Prelude @@ -45,6 +46,7 @@ import qualified Distribution.InstalledPackageInfo as IPI import Distribution.ModuleName (ModuleName) import Distribution.Package hiding (installedUnitId) import Distribution.PackageDescription +import Distribution.PackageDescription.Configuration (transformAllBuildDepends) import Distribution.Parsec (simpleParsec) import Distribution.Pretty import Distribution.Simple.Build.Macros (generateCabalMacrosHeader) @@ -63,6 +65,9 @@ import Distribution.Verbosity import Distribution.Version import Language.Haskell.Extension +import Distribution.Compat.Lens (over, view) +import qualified Distribution.Types.BuildInfo.Lens as L + import qualified Data.ByteString as BS import Data.List (stripPrefix) import qualified Data.Map as Map (fromList) @@ -110,6 +115,32 @@ loaded. See 'compatPackages'. The unit id of base stays - as mhs knows it, which is also the name of its package file. -} +{- Note [MicroHs rewrites of packages] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +MicroCabal rewrites the dependencies of every package it builds with mhs, and +so does cabal-install, see 'rewritePackageDescription': it rewrites the +packages it gives to the solver, so that the solver chooses, and cabal-install +builds, the packages mhs needs, as far as they are on Hackage or installed. +That is enough since cabal-install calls Cabal in-library (#11703): it +configures a package with the description of its plan, which is rewritten +already, rather than having a Setup script read the .cabal file of the +package again. Only a Custom setup script still would, and mhs cannot compile +one. + + * ghc-compat holds modules that are part of base in GHC but not in mhs, + such as GHC.Stack, GHC.Exts and Language.Haskell.TH.Syntax. Packages + written for GHC import them while depending only on base, so ghc-compat + becomes a dependency of every component, except in base, ghc-compat and + the packages of MicroHs itself; a component that depends on it already + keeps its own bounds. + * mhs cannot compile some packages from Hackage, and MicroHs has forks of + them on Hackage that it can: array-mhs and random-mhs. A dependency on the + original becomes one on the fork, of any version, as the bounds on the + original are about its own versions, and a re-export that names the + original names the fork. The version macros of the fork are defined under + the name of the original too, see 'cabalMacrosOptions'. +-} + -- ----------------------------------------------------------------------------- -- Configuring @@ -167,6 +198,66 @@ mhsLanguageExtensions = -- Extensions of MicroHs that GHC does not have. mhsSpecific = ["ExtraInstanceBindings", "ImportShadowing", "TypeLits"] +-- ----------------------------------------------------------------------------- +-- Package descriptions + +-- | The package description as MicroCabal builds the package with mhs, as +-- far as the packages it uses instead are available, which the predicate says. +-- See Note [MicroHs rewrites of packages]. +rewritePackageDescription + :: (PackageName -> Bool) -> GenericPackageDescription -> GenericPackageDescription +rewritePackageDescription available gpd0 + | packageName gpd0 `elem` withoutGhcCompat || not (available ghcCompat) = gpd + | otherwise = + gpd + { condLibrary = fmap addGhcCompat (condLibrary gpd) + , condSubLibraries = map (fmap addGhcCompat) (condSubLibraries gpd) + , condForeignLibs = map (fmap addGhcCompat) (condForeignLibs gpd) + , condExecutables = map (fmap addGhcCompat) (condExecutables gpd) + , condTestSuites = map (fmap addGhcCompat) (condTestSuites gpd) + , condBenchmarks = map (fmap addGhcCompat) (condBenchmarks gpd) + } + where + gpd = + forked + { condLibrary = fmap (fmap useForkReexports) (condLibrary forked) + , condSubLibraries = map (fmap (fmap useForkReexports)) (condSubLibraries forked) + } + forked = transformAllBuildDepends useFork gpd0 + useFork dep@(Dependency name _ libs) = + case lookup name forkedPackages of + Just fork | available fork -> Dependency fork anyVersion libs + _ -> dep + -- A re-export that names the package of a module names the fork too. + useForkReexports lib = lib{reexportedModules = map useForkReexport (reexportedModules lib)} + useForkReexport reexport@ModuleReexport{moduleReexportOriginalPackage = Just name} + | Just fork <- lookup name forkedPackages, available fork = reexport{moduleReexportOriginalPackage = Just fork} + useForkReexport reexport = reexport + ghcCompatDependency = Dependency ghcCompat anyVersion mainLibSet + -- Every component gets the dependency at its root, unless it depends on + -- ghc-compat there already, with bounds of its own. A dependency under a + -- condition, or in another component, is no reason to leave it out. + addGhcCompat :: L.HasBuildInfo a => CondTree v a -> CondTree v a + addGhcCompat node@(CondNode component branches) + | any ((== ghcCompat) . depPkgName) (view L.targetBuildDepends component) = node + | otherwise = CondNode (over L.targetBuildDepends (++ [ghcCompatDependency]) component) branches + +ghcCompat :: PackageName +ghcCompat = mkPackageName "ghc-compat" + +-- | The packages that are not built with ghc-compat, as MicroCabal has them: +-- base and ghc-compat themselves, and those of MicroHs. +withoutGhcCompat :: [PackageName] +withoutGhcCompat = map mkPackageName ["base", "ghc-compat", "MicroHs", "MicroCabal", "canvhs"] + +-- | The forks of packages from Hackage that mhs can compile, as MicroCabal +-- uses them. +forkedPackages :: [(PackageName, PackageName)] +forkedPackages = + [ (mkPackageName "array", mkPackageName "array-mhs") + , (mkPackageName "random", mkPackageName "random-mhs") + ] + -- ----------------------------------------------------------------------------- -- Installed packages @@ -581,14 +672,25 @@ dependencyPackageFiles verbosity lbi clbi = do -- on only the @-D@ and @-I@ options it is given, so that it cannot be told to -- include the header: every @#define@ of the header, with its continuation -- lines joined, becomes an option, and the first definition of a macro wins, --- as the @#ifndef@ guards of the header make it. +-- as the @#ifndef@ guards of the header make it. The macros of a fork of +-- 'forkedPackages' are also defined under the name of the package it forks, +-- as MicroCabal does: a package that depends on random tests +-- @MIN_VERSION_random@, which is then the version of random-mhs. cabalMacrosOptions :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> [String] cabalMacrosOptions pkg_descr lbi clbi = [ "-D" ++ lhs ++ "=" ++ rhs - | (_, lhs, rhs) <- ordNubBy (\(name, _, _) -> name) defines + | (_, lhs, rhs) <- ordNubBy (\(name, _, _) -> name) (defines ++ forkDefines) ] where header = generateCabalMacrosHeader pkg_descr lbi clbi + forkDefines = + [ (macro ++ mangle original, macro ++ mangle original ++ drop (length name) lhs, rhs) + | (original, fork) <- forkedPackages + , (name, lhs, rhs) <- defines + , macro <- ["VERSION_", "MIN_VERSION_"] + , name == macro ++ mangle fork + ] + mangle = map (\c -> if c == '-' then '_' else c) . unPackageName defines = [ (takeWhile (/= '(') lhs, lhs, dropWhile isSpace rhs) | line <- joinContinuations (lines header) diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs index 04815cea7d5..2aae7b07d95 100644 --- a/cabal-install/src/Distribution/Client/Dependency.hs +++ b/cabal-install/src/Distribution/Client/Dependency.hs @@ -59,6 +59,7 @@ module Distribution.Client.Dependency , setSolverVerbosity , removeLowerBounds , removeUpperBounds + , rewriteSourcePackages , addDefaultSetupDependencies , addSetupCabalMinVersionConstraint , addSetupCabalMaxVersionConstraint @@ -96,7 +97,8 @@ import Distribution.Client.Utils ) import qualified Distribution.Compat.Graph as Graph import Distribution.Compiler - ( CompilerInfo (..) + ( CompilerFlavor (..) + , CompilerInfo (..) ) import Distribution.Package ( Package (..) @@ -112,6 +114,7 @@ import Distribution.PackageDescription.Configuration ( finalizePD ) import qualified Distribution.PackageDescription.Configuration as PD +import qualified Distribution.Simple.MHS as MHS import Distribution.Simple.PackageIndex (InstalledPackageIndex) import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex import Distribution.Simple.Setup @@ -505,6 +508,25 @@ nonReinstallablePackages = , mkPackageName "template-haskell" ] +-- | Rewrite the descriptions of all the source packages as the compiler needs +-- them, given which packages the solver can choose from: for MicroHs, as +-- MicroCabal does. Rewriting them before solving is enough, as cabal-install +-- configures a package in-library with the description of its plan. See +-- Note [MicroHs rewrites of packages] in "Distribution.Simple.MHS". +rewriteSourcePackages :: CompilerFlavor -> DepResolverParams -> DepResolverParams +rewriteSourcePackages MHS params = + params + { depResolverSourcePkgIndex = + (\srcPkg -> srcPkg{srcpkgDescription = MHS.rewritePackageDescription available (srcpkgDescription srcPkg)}) + <$> sourcePkgIndex + } + where + sourcePkgIndex = depResolverSourcePkgIndex params + available name = + not (null (PackageIndex.lookupPackageName sourcePkgIndex name)) + || not (null (InstalledPackageIndex.lookupPackageName (depResolverInstalledPkgIndex params) name)) +rewriteSourcePackages _ params = params + addSourcePackages :: [UnresolvedSourcePackage] -> DepResolverParams diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index da185e990c0..a09ff4a0a54 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -1480,6 +1480,7 @@ planPackages , pkg <- localPackages , let pkgname = pkgSpecifierTarget pkg ] + . rewriteSourcePackages (compilerFlavor comp) $ stdResolverParams stdResolverParams :: DepResolverParams diff --git a/changelog.d/pr-11392.md b/changelog.d/pr-11392.md index 04e91600d37..fd8d1de8436 100644 --- a/changelog.d/pr-11392.md +++ b/changelog.d/pr-11392.md @@ -27,4 +27,8 @@ Since mhs ignores the `LANGUAGE` pragmas of the extensions it does not implement, packages are not rejected for the extensions they declare, and `reexported-modules` are accepted, as mhs sees all the modules of the packages it loads, unless they rename modules, which mhs cannot do. The macros of `cabal_macros.h`, such as `MIN_VERSION_base`, -are passed to mhs as `-D` options of its preprocessor. +are passed to mhs as `-D` options of its preprocessor. As MicroCabal does, the +packages are rewritten for mhs before solving: `ghc-compat`, which holds +modules that are part of `base` in GHC, becomes a dependency of every +component, and `array` and `random` are replaced by their forks `array-mhs` +and `random-mhs`, so that cabal builds what mhs needs from Hackage. From 9ba77627e64d95e67ad18fa10939c662df078992 Mon Sep 17 00:00:00 2001 From: Artem Pelenitsyn Date: Tue, 13 Oct 2026 07:16:27 -0400 Subject: [PATCH 5/6] Compile the C sources of libraries with mhs mhs compiles no C when it builds a library. It compiles the C sources of a library when it links a program that loads the package file of the library, from -/cbits beside the package file, which is where MicroCabal installs the c-sources of a library. Cabal ignored the C sources of libraries with a warning, and gave mhs no include directories of the dependencies of a component, so a program calling into the C code of a library failed to compile, as with time, which takes the time zone from C: fatal error: HsTime.h: No such file or directory buildLib now copies the c-sources of a library there, beside the package file in its build directory, and installLib copies them along with the package file. The headers are found as with GHC: the include-dirs that the registrations of the dependencies of a component list, which is where Cabal installs their install-includes for every compiler, are given to mhs with -I, which it passes on to the C compiler. See Note [MicroHs C files of libraries]. The cc-options of an executable are now passed to mhs, with -optc, for its own C sources. The headers beside the C sources go with them, as the sources include them relative to themselves, and the copies are what gets compiled. Two headers of the same name have to be the same header, as the C sources have to have distinct names, since mhs compiles them from one directory. The headers beside the C sources of the dependencies, such as those that hsc2hs generates for a #def, are on the include path too, for the C that mhs generates for their foreign imports. The linker options of a dependency without a package file to load, a library without modules say, are passed on from its registration, as -optl: into the package file of a library, so that they propagate, and to the link of a program. installLib removes what an earlier installation of the library left in its directory before copying, as mhs compiles every C file there. The test MHS/CSources builds a library with C sources, a private header beside them and an installed one, from a repository, into the store, and another one in place, and runs an executable calling both. The test MHS/Preprocess defines a C function with #def in the .hsc module of its library, which hsc2hs writes beside the module with a header, and calls it from the executable. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_0176vAefrw8jPKXdh9h1wKuj --- Cabal/src/Distribution/Simple/MHS.hs | 114 +++++++++++++++--- .../PackageTests/MHS/CSources/app/Main.hs | 14 +++ .../PackageTests/MHS/CSources/app/offset.c | 3 + .../PackageTests/MHS/CSources/app/offset.h | 1 + .../PackageTests/MHS/CSources/cabal.project | 3 + .../PackageTests/MHS/CSources/cabal.test.hs | 15 +++ .../PackageTests/MHS/CSources/cbits/twice.c | 4 + .../MHS/CSources/cbits/twice_impl.h | 1 + .../PackageTests/MHS/CSources/include/twice.h | 1 + .../MHS/CSources/mhs-csources.cabal | 24 ++++ .../CSources/repo/mhs-cdep-1.0/cbits/add.c | 4 + .../repo/mhs-cdep-1.0/cbits/add_impl.h | 1 + .../CSources/repo/mhs-cdep-1.0/include/add.h | 1 + .../CSources/repo/mhs-cdep-1.0/mhs-cdep.cabal | 15 +++ .../MHS/CSources/repo/mhs-cdep-1.0/src/Add.hs | 7 ++ .../PackageTests/MHS/CSources/src/Twice.hs | 5 + .../PackageTests/MHS/Preprocess/app/Main.hsc | 3 +- .../PackageTests/MHS/Preprocess/cabal.test.hs | 5 +- .../PackageTests/MHS/Preprocess/src/Sizes.hsc | 9 +- changelog.d/pr-11392.md | 9 +- 20 files changed, 219 insertions(+), 20 deletions(-) create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/app/Main.hs create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/app/offset.c create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/app/offset.h create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/cabal.project create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/cbits/twice.c create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/cbits/twice_impl.h create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/include/twice.h create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/mhs-csources.cabal create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/cbits/add.c create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/cbits/add_impl.h create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/include/add.h create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/mhs-cdep.cabal create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/src/Add.hs create mode 100644 cabal-testsuite/PackageTests/MHS/CSources/src/Twice.hs diff --git a/Cabal/src/Distribution/Simple/MHS.hs b/Cabal/src/Distribution/Simple/MHS.hs index 1ea9e58ae32..e3e6c434a77 100644 --- a/Cabal/src/Distribution/Simple/MHS.hs +++ b/Cabal/src/Distribution/Simple/MHS.hs @@ -72,8 +72,8 @@ import qualified Data.ByteString as BS import Data.List (stripPrefix) import qualified Data.Map as Map (fromList) import qualified Data.Text as Text -import System.Directory (doesDirectoryExist, getDirectoryContents, getHomeDirectory, makeAbsolute) -import System.FilePath (takeDirectory, takeExtension, takeFileName) +import System.Directory (doesDirectoryExist, getDirectoryContents, getHomeDirectory, makeAbsolute, removeDirectoryRecursive) +import System.FilePath (dropExtension, takeDirectory, takeExtension, takeFileName) {- Note [MicroHs package databases] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -141,6 +141,32 @@ one. the name of the original too, see 'cabalMacrosOptions'. -} +{- Note [MicroHs C files of libraries] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +mhs compiles no C when it builds a library: the C sources of a library are +compiled when a program that loads its package file is linked, along with the +C that mhs generates for the program. mhs takes them from beside the package +file /-.pkg, from /-/cbits/*.c. That +is where MicroCabal installs the c-sources of a library, and so does Cabal, +see 'layOutCSources': into the build directory, beside the package file that +'buildLib' writes, from where 'installLib' copies them with it. The headers +beside the C sources go with them, as the sources include them relative to +themselves, and the copies are what gets compiled. + +The headers that the C sources and the foreign imports of a program include +are found as with GHC: the include-dirs of the libraries a component depends +on, as their registrations list them, are given to mhs with -I, which it +passes on to the C compiler. Those of a library built in place are its own +include-dirs; once it is installed, the directory where its install-includes +are installed for every compiler. (MicroCabal installs the install-includes +into /-/include, which mhs adds to the include path +itself.) The extra-libraries and ld-options of a library are given to mhs as +-optl when it builds the library, and the package file keeps them. + +As the C sources are compiled with the options of the program, the cc-options +of the library do not apply to them. +-} + -- ----------------------------------------------------------------------------- -- Configuring @@ -556,11 +582,41 @@ buildLib verbosity pkg_descr lbi lib clbi = do dieWithException verbosity $ MhsRenamedReexports renamed createDirectoryIfMissingVerbose verbosity True (interpretSymbolicPathLBI lbi targetDir) - unless (null (cSources bi)) $ - warn verbosity "MicroHs cannot include C sources in a library; ignoring them." + unless (null (cxxSources bi ++ asmSources bi ++ cmmSources bi)) $ + warn verbosity "MicroHs compiles only the C sources of a library; ignoring its C++, assembler and Cmm sources." runMhs verbosity pkg_descr lbi bi clbi targetDir $ ["-P" ++ pkgId, "-o", interpretSymbolicPathCWD pkgFile] ++ map prettyShow modules + layOutCSources verbosity lbi bi (interpretSymbolicPathLBI lbi targetDir pkgId "cbits") + +-- | Copy the C sources of a library, and the headers beside them, into the +-- directory beside its package file where mhs looks for them, which is +-- emptied first. See Note [MicroHs C files of libraries]. +layOutCSources :: Verbosity -> LocalBuildInfo -> BuildInfo -> FilePath -> IO () +layOutCSources verbosity lbi bi dir = do + exists <- doesDirectoryExist dir + when exists $ removeDirectoryRecursive dir + let sources = ordNub (map (interpretSymbolicPathLBI lbi) (cSources bi)) + sameName a b = takeFileName a == takeFileName b + clashing = [source | source <- sources, length (filter (sameName source) sources) > 1] + unless (null clashing) $ + dieWithException verbosity $ + MhsCSourceNameClash clashing + -- The headers beside the C sources, which include them relative to + -- themselves, as cbits/foo.c includes "foo.h" for cbits/foo.h, go beside the + -- copies. Two headers of the same name have to be the same header. + headers <- concat <$> traverse (filesWithExtension ".h") (ordNub (map takeDirectory sources)) + differing <- flip filterM headers $ \header -> do + contents <- BS.readFile header + others <- traverse BS.readFile [other | other <- headers, other /= header, sameName other header] + return (any (/= contents) others) + unless (null differing) $ + dieWithException verbosity $ + MhsCSourceNameClash differing + unless (null sources) $ + createDirectoryIfMissingVerbose verbosity True dir + for_ (sources ++ headers) $ \file -> + installOrdinaryFile verbosity file (dir takeFileName file) buildExe :: Verbosity @@ -585,6 +641,7 @@ buildExe verbosity pkg_descr lbi exe clbi = do -- Compress the combinator code of the program, as MicroCabal does. ["-z"] ++ map u (cSources bi) + ++ concat [["-optc", Text.unpack opt] | opt <- ccOptions bi] ++ ["-o", u exeFile, u srcMainPath] -- | Run mhs with the arguments common to libraries and executables, followed @@ -604,11 +661,16 @@ runMhs verbosity pkg_descr lbi bi clbi generatedDir args = do mbWorkDir = mbWorkDirLBI lbi progdb = withPrograms lbi u = interpretSymbolicPathCWD -- See Note [Symbolic paths] in Distribution.Utils.Path - pkgFiles <- dependencyPackageFiles verbosity lbi clbi + closure <- dependencyClosure verbosity lbi clbi + located <- for closure $ \ipi -> (,) ipi <$> packageFile verbosity ipi -- The extra-lib-dirs are made absolute, as the package file of a library -- keeps the linker options for the programs linked elsewhere. libDirs <- traverse (makeAbsolute . interpretSymbolicPathLBI lbi) (extraLibDirs bi) - let commonArgs = + let pkgFiles = [pkgFile | (_, Just pkgFile) <- located] + -- The dependencies with no package file to load, see 'packageFile', + -- keep their linker options in their registration only. + unloaded = [ipi | (ipi, Nothing) <- located] + commonArgs = mhsVerbosityFlags verbosity -- The module search path: the source directories of the component -- instead of the default, the current directory. @@ -636,22 +698,35 @@ runMhs verbosity pkg_descr lbi bi clbi generatedDir args = do ++ ["-I" ++ u generatedDir] ++ [opt | opt <- map Text.unpack (cppOptions bi), any (`isPrefixOf` opt) ["-D", "-I"]] ++ ["-I" ++ u dir | dir <- includeDirs bi] + -- The headers of the dependencies, for the C that mhs compiles when + -- it links a program. See Note [MicroHs C files of libraries]. + ++ ["-I" ++ dir | dir <- ordNub (concatMap IPI.includeDirs closure)] + -- The headers beside the C sources of the dependencies, such as + -- those that hsc2hs generated, for the C that mhs generates for + -- their foreign imports. See 'layOutCSources'. + ++ ["-I" ++ dropExtension pkgFile "cbits" | pkgFile <- pkgFiles] ++ map Text.unpack (hcOptions MHS bi) ++ concat [["-optl", opt] | opt <- linkerOptions] linkerOptions = ["-L" ++ dir | dir <- libDirs] ++ ["-l" ++ Text.unpack lib | lib <- extraLibs bi] ++ map Text.unpack (ldOptions bi) + ++ concat + [ ["-L" ++ dir | dir <- IPI.libraryDirs ipi] + ++ ["-l" ++ lib | lib <- IPI.extraLibraries ipi] + ++ IPI.ldOptions ipi + | ipi <- unloaded + ] runDbProgramCwd verbosity mbWorkDir mhsProgram progdb (commonArgs ++ args) --- | The package files of the dependencies of a component, closed under the --- dependencies of the dependencies. -dependencyPackageFiles :: Verbosity -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO [FilePath] -dependencyPackageFiles verbosity lbi clbi = do +-- | The dependencies of a component, closed under the dependencies of the +-- dependencies. +dependencyClosure :: Verbosity -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO [InstalledPackageInfo] +dependencyClosure verbosity lbi clbi = -- The index of configure, with the libraries built since threaded in by -- build, has the dependencies, unless they were registered since the package -- was configured: then the package databases are read again. - closure <- case PackageIndex.dependencyClosure (installedPkgs lbi) deps of + case PackageIndex.dependencyClosure (installedPkgs lbi) deps of Left closure -> return (PackageIndex.allPackages closure) Right _ -> do index <- @@ -664,7 +739,6 @@ dependencyPackageFiles verbosity lbi clbi = do ordNub $ [dep | dep <- deps, isNothing (PackageIndex.lookupUnitId index dep)] ++ concatMap snd broken - catMaybes <$> traverse (packageFile verbosity) closure where deps = map fst (componentPackageDeps clbi) @@ -736,9 +810,16 @@ installLib -> ComponentLocalBuildInfo -> IO () installLib verbosity _lbi targetDir _dynlibTargetDir builtDir pkg lib _clbi = do - let pkgFile = mhsPackageId (packageId pkg) (libName lib) <.> "pkg" + let pkgId = mhsPackageId (packageId pkg) (libName lib) createDirectoryIfMissingVerbose verbosity True targetDir - installOrdinaryFile verbosity (builtDir pkgFile) (targetDir pkgFile) + installOrdinaryFile verbosity (builtDir pkgId <.> "pkg") (targetDir pkgId <.> "pkg") + -- The C files of the library, see Note [MicroHs C files of libraries]; + -- what an earlier installation of the library left there goes first. + stale <- doesDirectoryExist (targetDir pkgId) + when stale $ removeDirectoryRecursive (targetDir pkgId) + hasCFiles <- doesDirectoryExist (builtDir pkgId) + when hasCFiles $ + installDirectoryContents verbosity (builtDir pkgId) (targetDir pkgId) installExe :: Verbosity @@ -804,6 +885,7 @@ data MhsException | MhsRegistrationFileParseError FilePath [String] | MhsMissingDependencies [UnitId] | MhsRenamedReexports [ModuleReexport] + | MhsCSourceNameClash [FilePath] deriving (Show) instance Exception (VerboseException MhsException) where @@ -818,6 +900,7 @@ mhsExceptionCode err = case err of MhsRegistrationFileParseError{} -> 3203 MhsMissingDependencies{} -> 3204 MhsRenamedReexports{} -> 3205 + MhsCSourceNameClash{} -> 3206 mhsExceptionMessage :: MhsException -> String mhsExceptionMessage err = case err of @@ -834,3 +917,6 @@ mhsExceptionMessage err = case err of MhsRenamedReexports reexports -> "MicroHs provides the modules of a package under their own names only, so a library cannot re-export modules under other names: " ++ intercalate ", " (map prettyShow reexports) + MhsCSourceNameClash files -> + "MicroHs compiles the C sources of a library, and the headers beside them, from one directory, so they need distinct file names: " + ++ intercalate ", " files diff --git a/cabal-testsuite/PackageTests/MHS/CSources/app/Main.hs b/cabal-testsuite/PackageTests/MHS/CSources/app/Main.hs new file mode 100644 index 00000000000..ca1525ef23d --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/app/Main.hs @@ -0,0 +1,14 @@ +module Main (main) where + +import Add (add) +import Foreign.C.Types (CInt (..)) +import Twice (twice) + +foreign import ccall "offset.h csources_offset" offset :: IO CInt + +main :: IO () +main = do + putStrLn ("add 2 3 = " ++ show (add 2 3)) + putStrLn ("twice 21 = " ++ show (twice 21)) + o <- offset + putStrLn ("offset = " ++ show o) diff --git a/cabal-testsuite/PackageTests/MHS/CSources/app/offset.c b/cabal-testsuite/PackageTests/MHS/CSources/app/offset.c new file mode 100644 index 00000000000..f1fe7f90c3c --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/app/offset.c @@ -0,0 +1,3 @@ +#include "offset.h" + +int csources_offset(void) { return OFFSET; } diff --git a/cabal-testsuite/PackageTests/MHS/CSources/app/offset.h b/cabal-testsuite/PackageTests/MHS/CSources/app/offset.h new file mode 100644 index 00000000000..0614769c8f4 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/app/offset.h @@ -0,0 +1 @@ +int csources_offset(void); diff --git a/cabal-testsuite/PackageTests/MHS/CSources/cabal.project b/cabal-testsuite/PackageTests/MHS/CSources/cabal.project new file mode 100644 index 00000000000..3dccaec797b --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/cabal.project @@ -0,0 +1,3 @@ +packages: . +compiler: mhs +with-compiler: mhs diff --git a/cabal-testsuite/PackageTests/MHS/CSources/cabal.test.hs b/cabal-testsuite/PackageTests/MHS/CSources/cabal.test.hs new file mode 100644 index 00000000000..6d8239c18ad --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/cabal.test.hs @@ -0,0 +1,15 @@ +import Test.Cabal.Prelude + +-- The C sources of libraries with MicroHs, if it is installed: mhs compiles +-- them when it links a program, from beside the package file of the library, +-- with the install-includes of the library on the include path. mhs-cdep +-- comes from a repository and is installed in the store; mhs-csources is +-- built in place. +main = cabalTest $ do + skipUnless "no mhs" =<< isAvailableProgram mhsProgram + recordMode DoNotRecord $ withRepo "repo" $ do + cabal "v2-build" ["all"] + out <- cabal' "v2-run" ["mhs-csources"] + assertOutputContains "add 2 3 = 6" out + assertOutputContains "twice 21 = 42" out + assertOutputContains "offset = 7" out diff --git a/cabal-testsuite/PackageTests/MHS/CSources/cbits/twice.c b/cabal-testsuite/PackageTests/MHS/CSources/cbits/twice.c new file mode 100644 index 00000000000..2ef0927b27a --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/cbits/twice.c @@ -0,0 +1,4 @@ +#include "twice.h" +#include "twice_impl.h" + +int csources_twice(int x) { return CSOURCES_FACTOR * x; } diff --git a/cabal-testsuite/PackageTests/MHS/CSources/cbits/twice_impl.h b/cabal-testsuite/PackageTests/MHS/CSources/cbits/twice_impl.h new file mode 100644 index 00000000000..be2078c2164 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/cbits/twice_impl.h @@ -0,0 +1 @@ +#define CSOURCES_FACTOR 2 diff --git a/cabal-testsuite/PackageTests/MHS/CSources/include/twice.h b/cabal-testsuite/PackageTests/MHS/CSources/include/twice.h new file mode 100644 index 00000000000..34a44a45d6c --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/include/twice.h @@ -0,0 +1 @@ +int csources_twice(int x); diff --git a/cabal-testsuite/PackageTests/MHS/CSources/mhs-csources.cabal b/cabal-testsuite/PackageTests/MHS/CSources/mhs-csources.cabal new file mode 100644 index 00000000000..8c6315ddd65 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/mhs-csources.cabal @@ -0,0 +1,24 @@ +cabal-version: 3.0 +name: mhs-csources +version: 1.0 +build-type: Simple +license: BSD-3-Clause +synopsis: C sources with MicroHs + +library + exposed-modules: Twice + c-sources: cbits/twice.c + include-dirs: include + install-includes: twice.h + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 + +executable mhs-csources + main-is: Main.hs + c-sources: app/offset.c + include-dirs: app + cc-options: -DOFFSET=7 + build-depends: base, mhs-cdep, mhs-csources + hs-source-dirs: app + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/cbits/add.c b/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/cbits/add.c new file mode 100644 index 00000000000..5468816a739 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/cbits/add.c @@ -0,0 +1,4 @@ +#include "add.h" +#include "add_impl.h" + +int cdep_add(int x, int y) { return x + y + CDEP_BIAS; } diff --git a/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/cbits/add_impl.h b/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/cbits/add_impl.h new file mode 100644 index 00000000000..42ccab960bc --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/cbits/add_impl.h @@ -0,0 +1 @@ +#define CDEP_BIAS 1 diff --git a/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/include/add.h b/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/include/add.h new file mode 100644 index 00000000000..0154040aa72 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/include/add.h @@ -0,0 +1 @@ +int cdep_add(int x, int y); diff --git a/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/mhs-cdep.cabal b/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/mhs-cdep.cabal new file mode 100644 index 00000000000..3d6087ef7a1 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/mhs-cdep.cabal @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: mhs-cdep +version: 1.0 +build-type: Simple +license: BSD-3-Clause +synopsis: A library with C sources and a header + +library + exposed-modules: Add + c-sources: cbits/add.c + include-dirs: include + install-includes: add.h + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/src/Add.hs b/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/src/Add.hs new file mode 100644 index 00000000000..e0c433c2eaa --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/repo/mhs-cdep-1.0/src/Add.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE CApiFFI #-} + +module Add (add) where + +import Foreign.C.Types (CInt (..)) + +foreign import capi "add.h cdep_add" add :: CInt -> CInt -> CInt diff --git a/cabal-testsuite/PackageTests/MHS/CSources/src/Twice.hs b/cabal-testsuite/PackageTests/MHS/CSources/src/Twice.hs new file mode 100644 index 00000000000..932b7c85f11 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/CSources/src/Twice.hs @@ -0,0 +1,5 @@ +module Twice (twice) where + +import Foreign.C.Types (CInt (..)) + +foreign import ccall "twice.h csources_twice" twice :: CInt -> CInt diff --git a/cabal-testsuite/PackageTests/MHS/Preprocess/app/Main.hsc b/cabal-testsuite/PackageTests/MHS/Preprocess/app/Main.hsc index 911c174ed17..9790f95499a 100644 --- a/cabal-testsuite/PackageTests/MHS/Preprocess/app/Main.hsc +++ b/cabal-testsuite/PackageTests/MHS/Preprocess/app/Main.hsc @@ -1,6 +1,6 @@ module Main (main) where -import Sizes (intSize) +import Sizes (incr, intSize) #include @@ -12,3 +12,4 @@ main :: IO () main = do putStrLn ("sizeof int = " ++ show intSize) putStrLn ("char bits = " ++ show charBits) + putStrLn ("incr 41 = " ++ show (incr 41)) diff --git a/cabal-testsuite/PackageTests/MHS/Preprocess/cabal.test.hs b/cabal-testsuite/PackageTests/MHS/Preprocess/cabal.test.hs index 1d643728d67..7f6483a6e1d 100644 --- a/cabal-testsuite/PackageTests/MHS/Preprocess/cabal.test.hs +++ b/cabal-testsuite/PackageTests/MHS/Preprocess/cabal.test.hs @@ -3,7 +3,9 @@ import Test.Cabal.Prelude -- The modules that a preprocessor generates, with MicroHs, if it is installed -- along with hsc2hs: a module of the library and the main module of the -- executable come from .hsc files, which hsc2hs turns into Haskell in the --- build directories, where mhs has to find them. +-- build directories, where mhs has to find them. The library module defines a +-- C function with #def, which hsc2hs writes beside it with a header, and +-- imports it through that header. main = cabalTest $ do skipUnless "no mhs" =<< isAvailableProgram mhsProgram skipUnless "no hsc2hs" =<< isAvailableProgram hsc2hsProgram @@ -12,3 +14,4 @@ main = cabalTest $ do out <- cabal' "v2-run" ["mhs-preprocess"] assertOutputContains "sizeof int = 4" out assertOutputContains "char bits = 8" out + assertOutputContains "incr 41 = 42" out diff --git a/cabal-testsuite/PackageTests/MHS/Preprocess/src/Sizes.hsc b/cabal-testsuite/PackageTests/MHS/Preprocess/src/Sizes.hsc index 5131294e649..400388c8f89 100644 --- a/cabal-testsuite/PackageTests/MHS/Preprocess/src/Sizes.hsc +++ b/cabal-testsuite/PackageTests/MHS/Preprocess/src/Sizes.hsc @@ -1,7 +1,14 @@ -module Sizes (intSize) where +module Sizes (intSize, incr) where + +import Foreign.C.Types (CInt (..)) #include -- | The size of a C int, filled in by hsc2hs. intSize :: Int intSize = #size int + +-- A C function that hsc2hs writes beside the module, with a header for it. +#def int sizes_incr(int x) { return x + 1; } + +foreign import ccall "Sizes_hsc.h sizes_incr" incr :: CInt -> CInt diff --git a/changelog.d/pr-11392.md b/changelog.d/pr-11392.md index fd8d1de8436..6b64ecd33f4 100644 --- a/changelog.d/pr-11392.md +++ b/changelog.d/pr-11392.md @@ -13,9 +13,12 @@ Haskell compiler. Select it with `compiler: mhs` and `with-compiler: mhs` in The packages that come with mhs, such as `base`, are found through `mhs -L`. The libraries that Cabal builds are compiled into mhs package files, which the components depending on them preload, so that each component sees exactly the -packages it depends on. Only what simple packages need is implemented; there -is no support for Backpack, foreign libraries, profiling, shared libraries or -C sources in libraries. +packages it depends on. mhs compiles the C sources of a library when it links +a program that uses the library, so Cabal puts them, and the headers beside +them, beside its package file, where MicroCabal installs them too, and gives mhs the include directories of +the libraries a component depends on, as GHC gets them. Only what simple +packages need is implemented; there is no support for Backpack, foreign +libraries, profiling or shared libraries. The `base` of mhs is versioned like mhs itself and bundles the modules of `bytestring`, `text`, `deepseq`, `stm`, `directory`, `process`, `hashable` and From 44f201e4af9ff274ecfd5f16421ae445dde6158a Mon Sep 17 00:00:00 2001 From: Artem Pelenitsyn Date: Tue, 13 Oct 2026 09:16:15 -0400 Subject: [PATCH 6/6] Install libraries for mhs with cabal install --lib mhs has no package environments: it finds packages in the package directories of its search path, into which 'mhs -Q' installs them. With mhs, cabal install --lib crashed, as it asked about the package environments of a compiler other than GHC: Distribution.Simple.GHC.Props.getImplProps only worksfor GHC-like compilers (GHC, GHCJS), but found MHS It now installs the libraries, with the libraries they depend on that mhs does not find already, into a package directory of mhs with 'mhs -Q', and the C sources and headers of each beside it, where mhs looks for them. The directory is UserPackageDB, where MicroCabal installs packages, ~/.mcabal/mhs- or $CABALDIR/mhs-, unless another one is given with --package-env. After 'make minstall', ~/.mcabal/mhs- is the package directory of mhs itself, so that mhs finds the libraries there as it finds those of MicroCabal. The package directory of the user that the configuration of mhs names, ~/.mcabal-user/mhs-, would not do: MicroHs 0.16.9.0 does not search it, as it expands $VERSION in its configuration to its own directory instead of its version. cabal says whether mhs searches the directory or has to be given it with -a, as it has to when mhs is installed elsewhere; mhs names the directories of its search path as it reaches them, such as /path/to/bin/../mhs-0.16.9.0, so they are compared canonicalized. The directory of the C files of a library that 'install --lib' installs is named after its package file, whatever version the library is presented at, as mhs looks for it there, and the libraries installed are reported by that name too. The test MHS/InstallLib installs a library with a C source where MicroCabal installs and compiles a program using it with plain mhs; it sets CABALDIR to a directory of its own, as the home directory it sets is not honoured on Windows. Co-Authored-By: Claude Opus 5.5 Claude-Session: https://claude.ai/code/session_0176vAefrw8jPKXdh9h1wKuj --- Cabal/src/Distribution/Simple/MHS.hs | 131 +++++++++++++++--- .../src/Distribution/Client/CmdInstall.hs | 32 +++-- .../PackageTests/MHS/InstallLib/cabal.project | 3 + .../PackageTests/MHS/InstallLib/cabal.test.hs | 19 +++ .../MHS/InstallLib/cbits/triple.c | 3 + .../MHS/InstallLib/include/triple.h | 1 + .../MHS/InstallLib/mhs-installlib.cabal | 15 ++ .../PackageTests/MHS/InstallLib/prog/Prog.hs | 6 + .../PackageTests/MHS/InstallLib/src/Triple.hs | 5 + changelog.d/pr-11392.md | 7 + doc/cabal-commands.rst | 9 ++ 11 files changed, 203 insertions(+), 28 deletions(-) create mode 100644 cabal-testsuite/PackageTests/MHS/InstallLib/cabal.project create mode 100644 cabal-testsuite/PackageTests/MHS/InstallLib/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/MHS/InstallLib/cbits/triple.c create mode 100644 cabal-testsuite/PackageTests/MHS/InstallLib/include/triple.h create mode 100644 cabal-testsuite/PackageTests/MHS/InstallLib/mhs-installlib.cabal create mode 100644 cabal-testsuite/PackageTests/MHS/InstallLib/prog/Prog.hs create mode 100644 cabal-testsuite/PackageTests/MHS/InstallLib/src/Triple.hs diff --git a/Cabal/src/Distribution/Simple/MHS.hs b/Cabal/src/Distribution/Simple/MHS.hs index e3e6c434a77..26f8ea8be85 100644 --- a/Cabal/src/Distribution/Simple/MHS.hs +++ b/Cabal/src/Distribution/Simple/MHS.hs @@ -27,11 +27,13 @@ module Distribution.Simple.MHS , buildExe , installLib , installExe + , installInPackageDirectory , createPackageDB , registerPackage , rewritePackageDescription ) where +import Distribution.Compat.Environment (lookupEnv) import Distribution.Compat.Prelude import Prelude () @@ -72,8 +74,8 @@ import qualified Data.ByteString as BS import Data.List (stripPrefix) import qualified Data.Map as Map (fromList) import qualified Data.Text as Text -import System.Directory (doesDirectoryExist, getDirectoryContents, getHomeDirectory, makeAbsolute, removeDirectoryRecursive) -import System.FilePath (dropExtension, takeDirectory, takeExtension, takeFileName) +import System.Directory (canonicalizePath, doesDirectoryExist, getDirectoryContents, getHomeDirectory, makeAbsolute, removeDirectoryRecursive) +import System.FilePath (addTrailingPathSeparator, dropExtension, equalFilePath, normalise, takeDirectory, takeExtension, takeFileName) {- Note [MicroHs package databases] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -98,11 +100,14 @@ dependents without being registered again. GlobalPackageDB is the default search path of mhs, as 'mhs -L' reports it; it holds the packages that come with mhs, such as base. UserPackageDB is -~/.mcabal/mhs-, where MicroCabal, the package manager of MicroHs, -installs packages for the user. The packages of these directories have no -registration file: they are described by what 'mhs -L' reports about -them, with - as their unit id. A directory given as -SpecificPackageDB may hold such packages too. +~/.mcabal/mhs-, or $CABALDIR/mhs-, where MicroCabal, the +package manager of MicroHs, installs packages for the user, and where 'cabal +install --lib' installs libraries for mhs to find by itself, see +'installInPackageDirectory'. When mhs is installed with 'make minstall', it is +the package directory of mhs itself, and so part of GlobalPackageDB too. The +packages of these directories have no registration file: they are described by +what 'mhs -L' reports about them, with - as their unit +id. A directory given as SpecificPackageDB may hold such packages too. The base of mhs is versioned like mhs itself (base-0.16.9.0, say), and it bundles the modules of packages that are separate on Hackage: bytestring, @@ -350,11 +355,12 @@ globalPackageDbDirs verbosity progdb = do , ":" `isSuffixOf` line ] --- | Where MicroCabal installs packages for the user. +-- | Where MicroCabal installs packages for the user: ~/.mcabal/mhs-, +-- or $CABALDIR/mhs-. userPackageDbDir :: Compiler -> IO FilePath userPackageDbDir comp = do - home <- getHomeDirectory - return (home ".mcabal" prettyShow (compilerId comp)) + cabalDir <- maybe (( ".mcabal") <$> getHomeDirectory) return =<< lookupEnv "CABALDIR" + return (cabalDir prettyShow (compilerId comp)) -- | The packages of a package database directory. -- See Note [MicroHs package databases]. @@ -731,17 +737,22 @@ dependencyClosure verbosity lbi clbi = Right _ -> do index <- getInstalledPackages verbosity (compiler lbi) (mbWorkDirLBI lbi) (withPackageDB lbi) (withPrograms lbi) - case PackageIndex.dependencyClosure index deps of - Left closure -> return (PackageIndex.allPackages closure) - Right broken -> - dieWithException verbosity $ - MhsMissingDependencies $ - ordNub $ - [dep | dep <- deps, isNothing (PackageIndex.lookupUnitId index dep)] - ++ concatMap snd broken + closureIn verbosity index deps where deps = map fst (componentPackageDeps clbi) +-- | Units of a package index, with the units they depend on. +closureIn :: Verbosity -> InstalledPackageIndex -> [UnitId] -> IO [InstalledPackageInfo] +closureIn verbosity index unitIds = + case PackageIndex.dependencyClosure index unitIds of + Left closure -> return (PackageIndex.allPackages closure) + Right broken -> + dieWithException verbosity $ + MhsMissingDependencies $ + ordNub $ + [unitId | unitId <- unitIds, isNothing (PackageIndex.lookupUnitId index unitId)] + ++ concatMap snd broken + -- | The macros of @cabal_macros.h@ as @-D@ options of cpphs, to which mhs passes -- on only the @-D@ and @-I@ options it is given, so that it cannot be told to -- include the header: every @#define@ of the header, with its continuation @@ -842,6 +853,90 @@ installExe verbosity lbi binDir buildPref (progprefix, progsuffix) _pkg exe = do (buildPref exeName' exeName' <.> ext) (binDir progprefix ++ exeName' ++ progsuffix <.> ext) +-- | Install libraries, with the libraries they depend on, into a package +-- directory of mhs, as @mhs -Q@ does, so that mhs finds them by itself, as +-- @cabal install --lib@ makes GHC find libraries through an environment file. +-- The directory is UserPackageDB, where MicroCabal installs, unless another +-- one is given. The libraries that mhs finds already, in its default search +-- path or in the directory, are left alone. The message says whether mhs +-- searches the directory, or has to be given it with -a. See Note [MicroHs +-- package databases]. +installInPackageDirectory + :: Verbosity + -> Compiler + -> ProgramDb + -> PackageDBStackCWD + -- ^ the package databases that hold the libraries, once they are built + -> [UnitId] + -- ^ the libraries to install + -> Maybe FilePath + -- ^ the package directory, if not the one where MicroCabal installs + -> IO () +installInPackageDirectory verbosity comp progdb packageDbs unitIds mbDir = do + index <- getInstalledPackages verbosity comp Nothing (coercePackageDBStack packageDbs) progdb + dir <- maybe (userPackageDbDir comp) makeAbsolute mbDir + -- mhs lists the directories of its search path as it reaches them, such as + -- /path/to/bin/../mhs-0.16.9.0, so directories are compared canonicalized. + let searchedDirs = traverse canonicalizePath =<< globalPackageDbDirs verbosity progdb + searched <- searchedDirs + canonicalDir <- canonicalizePath dir + closure <- closureIn verbosity index unitIds + installed <- fmap catMaybes $ for closure $ \ipi -> do + mbPkgFile <- packageFile verbosity ipi + case mbPkgFile of + Just pkgFile -> do + pkgDir <- canonicalizePath (takeDirectory pkgFile) + if any (\d -> equalFilePath pkgDir (d "packages")) (canonicalDir : searched) + then return Nothing + else do + installPackageFile verbosity progdb ipi pkgFile dir + -- Named as mhs knows it, whatever version it is presented at. + return (Just (dropExtension (takeFileName pkgFile))) + Nothing -> return Nothing + -- mhs lists the directories of its search path that hold packages, as the + -- directory does now. + searchedNow <- searchedDirs + notice verbosity $ + if null installed + then "The libraries are where mhs finds them already." + else + "Installed " + ++ intercalate ", " installed + ++ " in " + ++ dir + ++ if any (equalFilePath canonicalDir) searchedNow + then ", where mhs finds them." + else ", where mhs finds them when given -a" ++ dir ++ "." + +-- | Install the package file of a library into a package directory with +-- @mhs -Q@, and beside it, where mhs looks for them, its C sources and the +-- headers installed with it. See Note [MicroHs C files of libraries]. +installPackageFile :: Verbosity -> ProgramDb -> InstalledPackageInfo -> FilePath -> FilePath -> IO () +installPackageFile verbosity progdb ipi pkgFile dir = do + runDbProgram verbosity mhsProgram progdb ["-Q", pkgFile, dir] + -- The directory of the C files is named after the package file, as mhs + -- looks for it, whatever version the library is presented at. + let cDir = dir "packages" dropExtension (takeFileName pkgFile) + cSourcesDir = dropExtension pkgFile "cbits" + -- The include-dirs within the installation of the library, rather than + -- those of the system. + ownIncludeDirs = + [ includeDir + | includeDir <- IPI.includeDirs ipi + , libDir <- IPI.libraryDirs ipi + , addTrailingPathSeparator (normalise libDir) `isPrefixOf` normalise includeDir + ] + -- What an earlier installation of the library left there goes first. + for_ [cDir "cbits", cDir "include"] $ \stale -> do + exists <- doesDirectoryExist stale + when exists $ removeDirectoryRecursive stale + hasCSources <- doesDirectoryExist cSourcesDir + when hasCSources $ + installDirectoryContents verbosity cSourcesDir (cDir "cbits") + includeDirs' <- filterM doesDirectoryExist (ordNub ownIncludeDirs) + for_ includeDirs' $ \includeDir -> + installDirectoryContents verbosity includeDir (cDir "include") + -- ----------------------------------------------------------------------------- -- Registering diff --git a/cabal-install/src/Distribution/Client/CmdInstall.hs b/cabal-install/src/Distribution/Client/CmdInstall.hs index 50e55e14c82..e367f70ed24 100644 --- a/cabal-install/src/Distribution/Client/CmdInstall.hs +++ b/cabal-install/src/Distribution/Client/CmdInstall.hs @@ -149,6 +149,7 @@ import Distribution.Simple.GHC , renderGhcEnvironmentFile ) import qualified Distribution.Simple.InstallDirs as InstallDirs +import qualified Distribution.Simple.MHS as MHS import qualified Distribution.Simple.PackageIndex as PI import Distribution.Simple.Program.Db ( defaultProgramDb @@ -526,16 +527,27 @@ installAction flags@NixStyleFlags{extraFlags, configFlags, installFlags, project -- Having built everything, do the install. unless dryRun $ if installLibs - then - installLibraries - verbosity - buildCtx - installedIndex - compiler - packageDbs - envFile - nonGlobalEnvEntries' - (not usedExistingPkgEnvFile && not usedPackageEnvFlag) + then case compilerFlavor of + MHS -> + MHS.installInPackageDirectory + verbosity + compiler + progDb + packageDbs + [unitId | GhcEnvFilePackageId unitId <- entriesForLibraryComponents (targetsMap buildCtx)] + (flagToMaybe (cinstEnvironmentPath clientInstallFlags)) + -- This should probably be GHC rather than a catch-all, as + -- installLibraries writes GHC environment files. + _ -> + installLibraries + verbosity + buildCtx + installedIndex + compiler + packageDbs + envFile + nonGlobalEnvEntries' + (not usedExistingPkgEnvFile && not usedPackageEnvFlag) else -- Install any built exe by symlinking or copying it we don't use -- BuildOutcomes because we also need the component names traverseInstall (installCheckUnitExes InstallCheckInstall) installCfg diff --git a/cabal-testsuite/PackageTests/MHS/InstallLib/cabal.project b/cabal-testsuite/PackageTests/MHS/InstallLib/cabal.project new file mode 100644 index 00000000000..3dccaec797b --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/InstallLib/cabal.project @@ -0,0 +1,3 @@ +packages: . +compiler: mhs +with-compiler: mhs diff --git a/cabal-testsuite/PackageTests/MHS/InstallLib/cabal.test.hs b/cabal-testsuite/PackageTests/MHS/InstallLib/cabal.test.hs new file mode 100644 index 00000000000..d57f6f227ad --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/InstallLib/cabal.test.hs @@ -0,0 +1,19 @@ +import Test.Cabal.Prelude + +import System.Directory (listDirectory) + +-- cabal install --lib with MicroHs, if it is installed: the library, with its +-- C source and its header, goes where MicroCabal installs packages, from where +-- mhs compiles a program that uses it, without cabal. +main = cabalTest $ do + skipUnless "no mhs" =<< isAvailableProgram mhsProgram + env <- getTestEnv + -- Where MicroCabal installs: $CABALDIR, set here to a directory of the + -- test, as the home directory that the test sets is not honoured on Windows. + let userDir = takeDirectory (testCabalDir env) ".mcabal" + recordMode DoNotRecord $ withEnv [("CABALDIR", Just userDir)] $ do + cabal' "v2-install" ["--lib"] >>= assertOutputContains "Installed mhs-installlib-1.0" + [versionDir] <- liftIO (listDirectory userDir) + let exe = testWorkDir env "prog" + _ <- runProgramM mhsProgram ["-a" ++ userDir versionDir, "prog/Prog.hs", "-o" ++ exe] Nothing + runM exe [] Nothing >>= assertOutputContains "triple 14 = 42" diff --git a/cabal-testsuite/PackageTests/MHS/InstallLib/cbits/triple.c b/cabal-testsuite/PackageTests/MHS/InstallLib/cbits/triple.c new file mode 100644 index 00000000000..a45b7db6ec3 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/InstallLib/cbits/triple.c @@ -0,0 +1,3 @@ +#include "triple.h" + +int triple(int x) { return 3 * x; } diff --git a/cabal-testsuite/PackageTests/MHS/InstallLib/include/triple.h b/cabal-testsuite/PackageTests/MHS/InstallLib/include/triple.h new file mode 100644 index 00000000000..8f8323dc305 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/InstallLib/include/triple.h @@ -0,0 +1 @@ +int triple(int x); diff --git a/cabal-testsuite/PackageTests/MHS/InstallLib/mhs-installlib.cabal b/cabal-testsuite/PackageTests/MHS/InstallLib/mhs-installlib.cabal new file mode 100644 index 00000000000..ec62582b576 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/InstallLib/mhs-installlib.cabal @@ -0,0 +1,15 @@ +cabal-version: 3.0 +name: mhs-installlib +version: 1.0 +build-type: Simple +license: BSD-3-Clause +synopsis: A library to install for mhs + +library + exposed-modules: Triple + c-sources: cbits/triple.c + include-dirs: include + install-includes: triple.h + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/MHS/InstallLib/prog/Prog.hs b/cabal-testsuite/PackageTests/MHS/InstallLib/prog/Prog.hs new file mode 100644 index 00000000000..f655777abd9 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/InstallLib/prog/Prog.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Triple (triple) + +main :: IO () +main = putStrLn ("triple 14 = " ++ show (triple 14)) diff --git a/cabal-testsuite/PackageTests/MHS/InstallLib/src/Triple.hs b/cabal-testsuite/PackageTests/MHS/InstallLib/src/Triple.hs new file mode 100644 index 00000000000..0e8332cc986 --- /dev/null +++ b/cabal-testsuite/PackageTests/MHS/InstallLib/src/Triple.hs @@ -0,0 +1,5 @@ +module Triple (triple) where + +import Foreign.C.Types (CInt (..)) + +foreign import ccall "triple.h triple" triple :: CInt -> CInt diff --git a/changelog.d/pr-11392.md b/changelog.d/pr-11392.md index 6b64ecd33f4..dd4dcd9700d 100644 --- a/changelog.d/pr-11392.md +++ b/changelog.d/pr-11392.md @@ -20,6 +20,13 @@ the libraries a component depends on, as GHC gets them. Only what simple packages need is implemented; there is no support for Backpack, foreign libraries, profiling or shared libraries. +With mhs, `cabal install --lib` installs libraries, with the libraries they +depend on, into a package directory of mhs, so that mhs finds them without +cabal: where MicroCabal installs packages, `~/.mcabal/mhs-VERSION`, which is +the package directory of mhs itself when it is installed with `make minstall` +and is also the user package database, or the directory given with +`--package-env`. + The `base` of mhs is versioned like mhs itself and bundles the modules of `bytestring`, `text`, `deepseq`, `stm`, `directory`, `process`, `hashable` and `integer-logarithms`. So that packages written for GHC solve, Cabal presents it diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index 5854e98de53..a68c418b29d 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -1004,6 +1004,15 @@ the name does not contain an extension, you must reference it as ``./myenv``. You can learn more about how to use these environments in `this section of the GHC manual `_. +MicroHs has no package environments: ``mhs`` finds libraries in package +directories. With ``mhs``, ``cabal install --lib`` installs the libraries, with +the libraries they depend on, where MicroCabal installs packages, +``~/.mcabal/mhs-$VERSION`` or ``$CABALDIR/mhs-$VERSION``, which is the package +directory of ``mhs`` itself when it is installed with ``make minstall``, or +into the directory given with ``--package-env``. ``cabal`` then says whether +``mhs`` searches the directory, or has to be given it with ``-a``, as in +``mhs -a/path/to/dir Main.hs``. + cabal haddock ^^^^^^^^^^^^^