Backpack #3672
There are no files selected for viewing
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,6 +1,7 @@ | ||
| # trivial gitignore file | ||
| .cabal-sandbox/ | ||
| cabal.sandbox.config | ||
| cabal.project.local | ||
| cabal-dev/ | ||
| .hpc/ | ||
| *.hi | ||
|
|
||
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -0,0 +1,248 @@ | ||
| {-# LANGUAGE FlexibleInstances #-} | ||
| {-# LANGUAGE RankNTypes #-} | ||
| {-# LANGUAGE PatternGuards #-} | ||
| {-# LANGUAGE DeriveGeneric #-} | ||
| {-# LANGUAGE DeriveDataTypeable #-} | ||
| {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
|
|
||
| -- | This module defines the core data types for Backpack. For more | ||
| -- details, see: | ||
| -- | ||
| -- <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst> | ||
|
|
||
| module Distribution.Backpack ( | ||
|
Contributor
There was a problem hiding this comment. For the sake of people reading hereafter, perhaps most of these new modules could include a link to the general backpack readme/proposal so we can say "don't know what definite/hole/etc means? go read the overview here ..." Indeed it's probably a good idea to keep a copy of the backpack spec in the Cabal repo (yes we ought to keep a live Cabal spec in the repo too). |
||
| -- * OpenUnitId | ||
| OpenUnitId(..), | ||
| openUnitIdComponentId, | ||
| openUnitIdFreeHoles, | ||
| mkOpenUnitId, | ||
|
|
||
| -- * DefUnitId | ||
| DefUnitId, | ||
| unDefUnitId, | ||
| mkDefUnitId, | ||
|
|
||
| -- * OpenModule | ||
| OpenModule(..), | ||
| openModuleFreeHoles, | ||
|
|
||
| -- * OpenModuleSubst | ||
| OpenModuleSubst, | ||
| dispOpenModuleSubst, | ||
| dispOpenModuleSubstEntry, | ||
| parseOpenModuleSubst, | ||
| parseOpenModuleSubstEntry, | ||
| openModuleSubstFreeHoles, | ||
|
|
||
| -- * Conversions to 'UnitId' | ||
| abstractUnitId, | ||
| hashModuleSubst, | ||
| ) where | ||
|
|
||
| import Prelude () | ||
| import Distribution.Compat.Prelude hiding (mod) | ||
| import Distribution.Compat.ReadP | ||
| import qualified Distribution.Compat.ReadP as Parse | ||
| import qualified Text.PrettyPrint as Disp | ||
| import Text.PrettyPrint (hcat) | ||
|
|
||
| import Distribution.ModuleName | ||
| import Distribution.Package | ||
| import Distribution.Text | ||
| import Distribution.Utils.Base62 | ||
|
|
||
| import qualified Data.Map as Map | ||
| import Data.Set (Set) | ||
| import qualified Data.Set as Set | ||
|
|
||
| ----------------------------------------------------------------------- | ||
| -- OpenUnitId | ||
|
|
||
| -- | An 'OpenUnitId' describes a (possibly partially) instantiated | ||
| -- Backpack component, with a description of how the holes are filled | ||
| -- in. Unlike 'OpenUnitId', the 'ModuleSubst' is kept in a structured | ||
| -- form that allows for substitution (which fills in holes.) This form | ||
| -- of unit cannot be installed. It must first be converted to a | ||
| -- 'UnitId'. | ||
| -- | ||
| -- In the absence of Backpack, there are no holes to fill, so any such | ||
| -- component always has an empty module substitution; thus we can lossly | ||
| -- represent it as an 'OpenUnitId uid'. | ||
| -- | ||
| -- For a source component using Backpack, however, there is more | ||
| -- structure as components may be parametrized over some signatures, and | ||
| -- these \"holes\" may be partially or wholly filled. | ||
| -- | ||
| -- OpenUnitId plays an important role when we are mix-in linking, | ||
| -- and is recorded to the installed packaged database for indefinite | ||
| -- packages; however, for compiled packages that are fully instantiated, | ||
| -- we instantiate 'OpenUnitId' into 'UnitId'. | ||
| -- | ||
| -- For more details see the Backpack spec | ||
| -- <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst> | ||
| -- | ||
|
|
||
| data OpenUnitId | ||
| -- | Identifies a component which may have some unfilled holes; | ||
| -- specifying its 'ComponentId' and its 'OpenModuleSubst'. | ||
| -- TODO: Invariant that 'OpenModuleSubst' is non-empty? | ||
| -- See also the Text instance. | ||
| = IndefFullUnitId ComponentId OpenModuleSubst | ||
| -- | Identifies a fully instantiated component, which has | ||
| -- been compiled and abbreviated as a hash. The embedded 'UnitId' | ||
| -- MUST NOT be for an indefinite component; an 'OpenUnitId' | ||
| -- is guaranteed not to have any holes. | ||
| | DefiniteUnitId DefUnitId | ||
| deriving (Generic, Read, Show, Eq, Ord, Typeable, Data) | ||
| -- TODO: cache holes? | ||
|
|
||
| instance Binary OpenUnitId | ||
|
|
||
| instance NFData OpenUnitId where | ||
| rnf (IndefFullUnitId cid subst) = rnf cid `seq` rnf subst | ||
| rnf (DefiniteUnitId uid) = rnf uid | ||
|
|
||
| instance Text OpenUnitId where | ||
| disp (IndefFullUnitId cid insts) | ||
| -- TODO: arguably a smart constructor to enforce invariant would be | ||
| -- better | ||
| | Map.null insts = disp cid | ||
| | otherwise = disp cid <<>> Disp.brackets (dispOpenModuleSubst insts) | ||
| disp (DefiniteUnitId uid) = disp uid | ||
| parse = parseOpenUnitId <++ fmap DefiniteUnitId parse | ||
| where | ||
| parseOpenUnitId = do | ||
| cid <- parse | ||
| insts <- Parse.between (Parse.char '[') (Parse.char ']') | ||
| parseOpenModuleSubst | ||
| return (IndefFullUnitId cid insts) | ||
|
|
||
| -- | Get the 'ComponentId' of an 'OpenUnitId'. | ||
| openUnitIdComponentId :: OpenUnitId -> ComponentId | ||
| openUnitIdComponentId (IndefFullUnitId cid _) = cid | ||
| openUnitIdComponentId (DefiniteUnitId def_uid) = unitIdComponentId (unDefUnitId def_uid) | ||
|
|
||
| -- | Get the set of holes ('ModuleVar') embedded in a 'UnitId'. | ||
| openUnitIdFreeHoles :: OpenUnitId -> Set ModuleName | ||
| openUnitIdFreeHoles (IndefFullUnitId _ insts) = openModuleSubstFreeHoles insts | ||
| openUnitIdFreeHoles _ = Set.empty | ||
|
|
||
| -- | Safe constructor from a UnitId. The only way to do this safely | ||
| -- is if the instantiation is provided. | ||
| mkOpenUnitId :: UnitId -> OpenModuleSubst -> OpenUnitId | ||
| mkOpenUnitId uid insts = | ||
| if Set.null (openModuleSubstFreeHoles insts) | ||
| then DefiniteUnitId (unsafeMkDefUnitId uid) -- invariant holds! | ||
| else IndefFullUnitId (unitIdComponentId uid) insts | ||
|
|
||
| ----------------------------------------------------------------------- | ||
| -- DefUnitId | ||
|
|
||
| -- | Create a 'DefUnitId' from a 'ComponentId' and an instantiation | ||
| -- with no holes. | ||
| mkDefUnitId :: ComponentId -> Map ModuleName Module -> DefUnitId | ||
| mkDefUnitId cid insts = | ||
| unsafeMkDefUnitId (UnitId cid (hashModuleSubst insts)) -- impose invariant! | ||
|
|
||
| ----------------------------------------------------------------------- | ||
| -- OpenModule | ||
|
|
||
| -- | Unlike a 'Module', an 'OpenModule' is either an ordinary | ||
| -- module from some unit, OR an 'OpenModuleVar', representing a | ||
| -- hole that needs to be filled in. Substitutions are over | ||
| -- module variables. | ||
| data OpenModule | ||
| = OpenModule OpenUnitId ModuleName | ||
| | OpenModuleVar ModuleName | ||
| deriving (Generic, Read, Show, Eq, Ord, Typeable, Data) | ||
|
|
||
| instance Binary OpenModule | ||
|
|
||
| instance NFData OpenModule where | ||
| rnf (OpenModule uid mod_name) = rnf uid `seq` rnf mod_name | ||
| rnf (OpenModuleVar mod_name) = rnf mod_name | ||
|
|
||
| instance Text OpenModule where | ||
| disp (OpenModule uid mod_name) = | ||
| hcat [disp uid, Disp.text ":", disp mod_name] | ||
| disp (OpenModuleVar mod_name) = | ||
| hcat [Disp.char '<', disp mod_name, Disp.char '>'] | ||
| parse = parseModuleVar <++ parseOpenModule | ||
| where | ||
| parseOpenModule = do | ||
| uid <- parse | ||
| _ <- Parse.char ':' | ||
| mod_name <- parse | ||
| return (OpenModule uid mod_name) | ||
| parseModuleVar = do | ||
| _ <- Parse.char '<' | ||
| mod_name <- parse | ||
| _ <- Parse.char '>' | ||
| return (OpenModuleVar mod_name) | ||
|
|
||
| -- | Get the set of holes ('ModuleVar') embedded in a 'Module'. | ||
| openModuleFreeHoles :: OpenModule -> Set ModuleName | ||
| openModuleFreeHoles (OpenModuleVar mod_name) = Set.singleton mod_name | ||
| openModuleFreeHoles (OpenModule uid _n) = openUnitIdFreeHoles uid | ||
|
|
||
| ----------------------------------------------------------------------- | ||
| -- OpenModuleSubst | ||
|
|
||
| -- | An explicit substitution on modules. | ||
| -- | ||
| -- NB: These substitutions are NOT idempotent, for example, a | ||
| -- valid substitution is (A -> B, B -> A). | ||
| type OpenModuleSubst = Map ModuleName OpenModule | ||
|
|
||
| -- | Pretty-print the entries of a module substitution, suitable | ||
| -- for embedding into a 'OpenUnitId' or passing to GHC via @--instantiate-with@. | ||
| dispOpenModuleSubst :: OpenModuleSubst -> Disp.Doc | ||
| dispOpenModuleSubst subst | ||
| = Disp.hcat | ||
| . Disp.punctuate Disp.comma | ||
| $ map dispOpenModuleSubstEntry (Map.toAscList subst) | ||
|
|
||
| -- | Pretty-print a single entry of a module substitution. | ||
| dispOpenModuleSubstEntry :: (ModuleName, OpenModule) -> Disp.Doc | ||
| dispOpenModuleSubstEntry (k, v) = disp k <<>> Disp.char '=' <<>> disp v | ||
|
|
||
| -- | Inverse to 'dispModSubst'. | ||
| parseOpenModuleSubst :: ReadP r OpenModuleSubst | ||
| parseOpenModuleSubst = fmap Map.fromList | ||
| . flip Parse.sepBy (Parse.char ',') | ||
| $ parseOpenModuleSubstEntry | ||
|
|
||
| -- | Inverse to 'dispModSubstEntry'. | ||
| parseOpenModuleSubstEntry :: ReadP r (ModuleName, OpenModule) | ||
| parseOpenModuleSubstEntry = | ||
| do k <- parse | ||
| _ <- Parse.char '=' | ||
| v <- parse | ||
| return (k, v) | ||
|
|
||
| -- | Get the set of holes ('ModuleVar') embedded in a 'OpenModuleSubst'. | ||
| -- This is NOT the domain of the substitution. | ||
| openModuleSubstFreeHoles :: OpenModuleSubst -> Set ModuleName | ||
| openModuleSubstFreeHoles insts = Set.unions (map openModuleFreeHoles (Map.elems insts)) | ||
|
|
||
| ----------------------------------------------------------------------- | ||
| -- Conversions to UnitId | ||
|
|
||
| -- | When typechecking, we don't demand that a freshly instantiated | ||
| -- 'IndefFullUnitId' be compiled; instead, we just depend on the | ||
| -- installed indefinite unit installed at the 'ComponentId'. | ||
| abstractUnitId :: OpenUnitId -> UnitId | ||
| abstractUnitId (DefiniteUnitId def_uid) = unDefUnitId def_uid | ||
| abstractUnitId (IndefFullUnitId cid _) = newSimpleUnitId cid | ||
|
|
||
| -- | Take a module substitution and hash it into a string suitable for | ||
| -- 'UnitId'. Note that since this takes 'Module', not 'OpenModule', | ||
| -- you are responsible for recursively converting 'OpenModule' | ||
| -- into 'Module'. See also "Distribution.Backpack.ReadyComponent". | ||
| hashModuleSubst :: Map ModuleName Module -> Maybe String | ||
| hashModuleSubst subst | ||
| | Map.null subst = Nothing | ||
| | otherwise = | ||
| Just . hashToBase62 $ | ||
| concat [ display mod_name ++ "=" ++ display m ++ "\n" | ||
| | (mod_name, m) <- Map.toList subst] | ||
Oops, something went wrong.
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Just wondering about this D.Utils namespace. Is this really a public facing part of the Cabal API, or part of the build system, or part of the backpack subdivision of Cabal. (I'm distinguishing Cabal the declarative package specish bits from the "simple" build system.)
Do all of these need to be in exposed modules?
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
NubListis used in cabal-install, so it needs to be exposed.There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Would this be a case for an explicit "Internal" module space? Seems it would be a good idea for cases where things have to be exposed for "incidental" reasons.
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Yeah, a lot of these actually are used by cabal-install. For example, in the Backpack namespace, cabal-install imports Distribution.Backpack.ConfiguredComponent, Distribution.Backpack.LinkedComponent, Distribution.Backpack.ComponentsGraph, Distribution.Backpack.ModuleShape, Distribution.Backpack.ModSubst, and Distribution.Backpack. So I guess we could hide the stuff for actually implementing mix-in linking, but a good chunk of this stuff also needs to stay.