{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeSynonymInstances #-}
module GHC.Unit.Module
( module GHC.Unit.Types
, module GHC.Unit.Module.Name
, module GHC.Unit.Module.Location
, module GHC.Unit.Module.Env
, getModuleInstantiation
, getUnitInstantiations
, uninstantiateInstantiatedUnit
, uninstantiateInstantiatedModule
, mkHoleModule
, isHoleModule
, stableModuleCmp
, moduleStableString
, moduleIsDefinite
, HasModule(..)
, ContainsModule(..)
, unitIdEq
, installedModuleEq
) where
import GHC.Prelude
import GHC.Types.Unique.DSet
import GHC.Unit.Types
import GHC.Unit.Module.Name
import GHC.Unit.Module.Location
import GHC.Unit.Module.Env
import GHC.Utils.Misc
moduleIsDefinite :: Module -> Bool
moduleIsDefinite :: Module -> Bool
moduleIsDefinite = UniqDSet ModuleName -> Bool
forall a. UniqDSet a -> Bool
isEmptyUniqDSet (UniqDSet ModuleName -> Bool)
-> (Module -> UniqDSet ModuleName) -> Module -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Module -> UniqDSet ModuleName
forall u. GenModule (GenUnit u) -> UniqDSet ModuleName
moduleFreeHoles
moduleStableString :: Module -> String
moduleStableString :: Module -> String
moduleStableString Module{ModuleName
Unit
moduleUnit :: forall unit. GenModule unit -> unit
moduleName :: forall unit. GenModule unit -> ModuleName
moduleName :: ModuleName
moduleUnit :: Unit
..} =
String
"$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Unit -> String
unitString Unit
moduleUnit String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"$" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ModuleName -> String
moduleNameString ModuleName
moduleName
stableModuleCmp :: Module -> Module -> Ordering
stableModuleCmp :: Module -> Module -> Ordering
stableModuleCmp (Module Unit
p1 ModuleName
n1) (Module Unit
p2 ModuleName
n2)
= (Unit
p1 Unit -> Unit -> Ordering
`stableUnitCmp` Unit
p2) Ordering -> Ordering -> Ordering
`thenCmp`
(ModuleName
n1 ModuleName -> ModuleName -> Ordering
`stableModuleNameCmp` ModuleName
n2)
class ContainsModule t where
:: t -> Module
class HasModule m where
getModule :: m Module
installedModuleEq :: InstalledModule -> Module -> Bool
installedModuleEq :: InstalledModule -> Module -> Bool
installedModuleEq InstalledModule
imod Module
mod =
(InstalledModule, Maybe InstantiatedModule) -> InstalledModule
forall a b. (a, b) -> a
fst (Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
mod) InstalledModule -> InstalledModule -> Bool
forall a. Eq a => a -> a -> Bool
== InstalledModule
imod
unitIdEq :: UnitId -> Unit -> Bool
unitIdEq :: UnitId -> Unit -> Bool
unitIdEq UnitId
iuid Unit
uid = Unit -> UnitId
toUnitId Unit
uid UnitId -> UnitId -> Bool
forall a. Eq a => a -> a -> Bool
== UnitId
iuid
getModuleInstantiation :: Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation :: Module -> (InstalledModule, Maybe InstantiatedModule)
getModuleInstantiation Module
m =
let (UnitId
uid, Maybe InstantiatedUnit
mb_iuid) = Unit -> (UnitId, Maybe InstantiatedUnit)
getUnitInstantiations (Module -> Unit
forall unit. GenModule unit -> unit
moduleUnit Module
m)
in (UnitId -> ModuleName -> InstalledModule
forall unit. unit -> ModuleName -> GenModule unit
Module UnitId
uid (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m),
(InstantiatedUnit -> InstantiatedModule)
-> Maybe InstantiatedUnit -> Maybe InstantiatedModule
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\InstantiatedUnit
iuid -> InstantiatedUnit -> ModuleName -> InstantiatedModule
forall unit. unit -> ModuleName -> GenModule unit
Module InstantiatedUnit
iuid (Module -> ModuleName
forall unit. GenModule unit -> ModuleName
moduleName Module
m)) Maybe InstantiatedUnit
mb_iuid)
getUnitInstantiations :: Unit -> (UnitId, Maybe InstantiatedUnit)
getUnitInstantiations :: Unit -> (UnitId, Maybe InstantiatedUnit)
getUnitInstantiations (VirtUnit InstantiatedUnit
iuid) = (Indefinite UnitId -> UnitId
forall unit. Indefinite unit -> unit
indefUnit (InstantiatedUnit -> Indefinite UnitId
forall unit. GenInstantiatedUnit unit -> Indefinite unit
instUnitInstanceOf InstantiatedUnit
iuid), InstantiatedUnit -> Maybe InstantiatedUnit
forall a. a -> Maybe a
Just InstantiatedUnit
iuid)
getUnitInstantiations (RealUnit (Definite UnitId
uid)) = (UnitId
uid, Maybe InstantiatedUnit
forall a. Maybe a
Nothing)
getUnitInstantiations Unit
HoleUnit = String -> (UnitId, Maybe InstantiatedUnit)
forall a. HasCallStack => String -> a
error String
"Hole unit"
uninstantiateInstantiatedUnit :: InstantiatedUnit -> InstantiatedUnit
uninstantiateInstantiatedUnit :: InstantiatedUnit -> InstantiatedUnit
uninstantiateInstantiatedUnit InstantiatedUnit
u =
Indefinite UnitId -> Instantiations -> InstantiatedUnit
mkInstantiatedUnit (InstantiatedUnit -> Indefinite UnitId
forall unit. GenInstantiatedUnit unit -> Indefinite unit
instUnitInstanceOf InstantiatedUnit
u)
(((ModuleName, Module) -> (ModuleName, Module))
-> Instantiations -> Instantiations
forall a b. (a -> b) -> [a] -> [b]
map (\(ModuleName
m,Module
_) -> (ModuleName
m, ModuleName -> Module
forall u. ModuleName -> GenModule (GenUnit u)
mkHoleModule ModuleName
m))
(InstantiatedUnit -> Instantiations
forall unit. GenInstantiatedUnit unit -> GenInstantiations unit
instUnitInsts InstantiatedUnit
u))
uninstantiateInstantiatedModule :: InstantiatedModule -> InstantiatedModule
uninstantiateInstantiatedModule :: InstantiatedModule -> InstantiatedModule
uninstantiateInstantiatedModule (Module InstantiatedUnit
uid ModuleName
n) = InstantiatedUnit -> ModuleName -> InstantiatedModule
forall unit. unit -> ModuleName -> GenModule unit
Module (InstantiatedUnit -> InstantiatedUnit
uninstantiateInstantiatedUnit InstantiatedUnit
uid) ModuleName
n
isHoleModule :: GenModule (GenUnit u) -> Bool
isHoleModule :: forall u. GenModule (GenUnit u) -> Bool
isHoleModule (Module GenUnit u
HoleUnit ModuleName
_) = Bool
True
isHoleModule GenModule (GenUnit u)
_ = Bool
False
mkHoleModule :: ModuleName -> GenModule (GenUnit u)
mkHoleModule :: forall u. ModuleName -> GenModule (GenUnit u)
mkHoleModule = GenUnit u -> ModuleName -> GenModule (GenUnit u)
forall unit. unit -> ModuleName -> GenModule unit
Module GenUnit u
forall uid. GenUnit uid
HoleUnit