Safe Haskell | None |
---|---|
Language | Haskell2010 |
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
Synopsis
- data OpenUnitId
- openUnitIdFreeHoles :: OpenUnitId -> Set ModuleName
- mkOpenUnitId :: UnitId -> ComponentId -> OpenModuleSubst -> OpenUnitId
- data DefUnitId
- unDefUnitId :: DefUnitId -> UnitId
- mkDefUnitId :: ComponentId -> Map ModuleName Module -> DefUnitId
- data OpenModule
- openModuleFreeHoles :: OpenModule -> Set ModuleName
- type OpenModuleSubst = Map ModuleName OpenModule
- dispOpenModuleSubst :: OpenModuleSubst -> Doc
- dispOpenModuleSubstEntry :: (ModuleName, OpenModule) -> Doc
- parsecOpenModuleSubst :: CabalParsing m => m OpenModuleSubst
- parsecOpenModuleSubstEntry :: CabalParsing m => m (ModuleName, OpenModule)
- openModuleSubstFreeHoles :: OpenModuleSubst -> Set ModuleName
- abstractUnitId :: OpenUnitId -> UnitId
- hashModuleSubst :: Map ModuleName Module -> Maybe String
OpenUnitId
data OpenUnitId Source #
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 lossily represent it as a 'DefiniteUnitId 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
IndefFullUnitId ComponentId OpenModuleSubst | Identifies a component which may have some unfilled holes;
specifying its |
DefiniteUnitId DefUnitId | Identifies a fully instantiated component, which has
been compiled and abbreviated as a hash. The embedded |
Instances
openUnitIdFreeHoles :: OpenUnitId -> Set ModuleName Source #
Get the set of holes (ModuleVar
) embedded in a UnitId
.
mkOpenUnitId :: UnitId -> ComponentId -> OpenModuleSubst -> OpenUnitId Source #
Safe constructor from a UnitId. The only way to do this safely is if the instantiation is provided.
DefUnitId
A UnitId
for a definite package. The DefUnitId
invariant says
that a UnitId
identified this way is definite; i.e., it has no
unfilled holes.
Instances
Parsec DefUnitId Source # | |||||
Defined in Distribution.Types.UnitId parsec :: CabalParsing m => m DefUnitId Source # | |||||
Pretty DefUnitId Source # | |||||
Defined in Distribution.Types.UnitId | |||||
Structured DefUnitId Source # | |||||
Defined in Distribution.Types.UnitId | |||||
Binary DefUnitId Source # | |||||
NFData DefUnitId Source # | |||||
Defined in Distribution.Types.UnitId | |||||
Data DefUnitId Source # | |||||
Defined in Distribution.Types.UnitId gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> DefUnitId -> c DefUnitId # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c DefUnitId # toConstr :: DefUnitId -> Constr # dataTypeOf :: DefUnitId -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c DefUnitId) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DefUnitId) # gmapT :: (forall b. Data b => b -> b) -> DefUnitId -> DefUnitId # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> DefUnitId -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> DefUnitId -> r # gmapQ :: (forall d. Data d => d -> u) -> DefUnitId -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> DefUnitId -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> DefUnitId -> m DefUnitId # | |||||
Generic DefUnitId Source # | |||||
Defined in Distribution.Types.UnitId
| |||||
Read DefUnitId Source # | |||||
Show DefUnitId Source # | |||||
Eq DefUnitId Source # | |||||
Ord DefUnitId Source # | |||||
Defined in Distribution.Types.UnitId | |||||
type Rep DefUnitId Source # | |||||
Defined in Distribution.Types.UnitId |
unDefUnitId :: DefUnitId -> UnitId Source #
mkDefUnitId :: ComponentId -> Map ModuleName Module -> DefUnitId Source #
Create a DefUnitId
from a ComponentId
and an instantiation
with no holes.
OpenModule
data OpenModule Source #
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.
Instances
Parsec OpenModule Source # |
| ||||
Defined in Distribution.Backpack parsec :: CabalParsing m => m OpenModule Source # | |||||
Pretty OpenModule Source # | |||||
Defined in Distribution.Backpack pretty :: OpenModule -> Doc Source # prettyVersioned :: CabalSpecVersion -> OpenModule -> Doc Source # | |||||
Structured OpenModule Source # | |||||
Defined in Distribution.Backpack structure :: Proxy OpenModule -> Structure Source # structureHash' :: Tagged OpenModule MD5 | |||||
Binary OpenModule Source # | |||||
Defined in Distribution.Backpack put :: OpenModule -> Put Source # get :: Get OpenModule Source # putList :: [OpenModule] -> Put Source # | |||||
NFData OpenModule Source # | |||||
Defined in Distribution.Backpack rnf :: OpenModule -> () Source # | |||||
Data OpenModule Source # | |||||
Defined in Distribution.Backpack gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> OpenModule -> c OpenModule # gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c OpenModule # toConstr :: OpenModule -> Constr # dataTypeOf :: OpenModule -> DataType # dataCast1 :: Typeable t => (forall d. Data d => c (t d)) -> Maybe (c OpenModule) # dataCast2 :: Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c OpenModule) # gmapT :: (forall b. Data b => b -> b) -> OpenModule -> OpenModule # gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> OpenModule -> r # gmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> OpenModule -> r # gmapQ :: (forall d. Data d => d -> u) -> OpenModule -> [u] # gmapQi :: Int -> (forall d. Data d => d -> u) -> OpenModule -> u # gmapM :: Monad m => (forall d. Data d => d -> m d) -> OpenModule -> m OpenModule # gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> OpenModule -> m OpenModule # gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> OpenModule -> m OpenModule # | |||||
Generic OpenModule Source # | |||||
Defined in Distribution.Backpack
from :: OpenModule -> Rep OpenModule x # to :: Rep OpenModule x -> OpenModule # | |||||
Read OpenModule Source # | |||||
Defined in Distribution.Backpack readsPrec :: Int -> ReadS OpenModule # readList :: ReadS [OpenModule] # readPrec :: ReadPrec OpenModule # readListPrec :: ReadPrec [OpenModule] # | |||||
Show OpenModule Source # | |||||
Defined in Distribution.Backpack showsPrec :: Int -> OpenModule -> ShowS # show :: OpenModule -> String # showList :: [OpenModule] -> ShowS # | |||||
Eq OpenModule Source # | |||||
Defined in Distribution.Backpack (==) :: OpenModule -> OpenModule -> Bool # (/=) :: OpenModule -> OpenModule -> Bool # | |||||
Ord OpenModule Source # | |||||
Defined in Distribution.Backpack compare :: OpenModule -> OpenModule -> Ordering # (<) :: OpenModule -> OpenModule -> Bool # (<=) :: OpenModule -> OpenModule -> Bool # (>) :: OpenModule -> OpenModule -> Bool # (>=) :: OpenModule -> OpenModule -> Bool # max :: OpenModule -> OpenModule -> OpenModule # min :: OpenModule -> OpenModule -> OpenModule # | |||||
type Rep OpenModule Source # | |||||
Defined in Distribution.Backpack type Rep OpenModule = D1 ('MetaData "OpenModule" "Distribution.Backpack" "Cabal-syntax-3.14.0.0-e3f5" 'False) (C1 ('MetaCons "OpenModule" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 OpenUnitId) :*: S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ModuleName)) :+: C1 ('MetaCons "OpenModuleVar" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedLazy) (Rec0 ModuleName))) |
openModuleFreeHoles :: OpenModule -> Set ModuleName Source #
Get the set of holes (ModuleVar
) embedded in a Module
.
OpenModuleSubst
type OpenModuleSubst = Map ModuleName OpenModule Source #
An explicit substitution on modules.
NB: These substitutions are NOT idempotent, for example, a valid substitution is (A -> B, B -> A).
dispOpenModuleSubst :: OpenModuleSubst -> Doc Source #
Pretty-print the entries of a module substitution, suitable
for embedding into a OpenUnitId
or passing to GHC via --instantiate-with
.
dispOpenModuleSubstEntry :: (ModuleName, OpenModule) -> Doc Source #
Pretty-print a single entry of a module substitution.
parsecOpenModuleSubst :: CabalParsing m => m OpenModuleSubst Source #
Inverse to dispModSubst
.
Since: Cabal-syntax-2.2
parsecOpenModuleSubstEntry :: CabalParsing m => m (ModuleName, OpenModule) Source #
Inverse to dispModSubstEntry
.
Since: Cabal-syntax-2.2
openModuleSubstFreeHoles :: OpenModuleSubst -> Set ModuleName Source #
Get the set of holes (ModuleVar
) embedded in a OpenModuleSubst
.
This is NOT the domain of the substitution.
Conversions to UnitId
abstractUnitId :: OpenUnitId -> UnitId Source #
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
.
hashModuleSubst :: Map ModuleName Module -> Maybe String Source #
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.