never executed always true always false

    1 {-# LANGUAGE ExplicitNamespaces #-}
    2 {-# LANGUAGE FlexibleInstances #-}
    3 {-# LANGUAGE MultiParamTypeClasses #-}
    4 {-# LANGUAGE RecordWildCards #-}
    5 
    6 {-
    7 (c) The University of Glasgow, 2004-2006
    8 
    9 
   10 Module
   11 ~~~~~~~~~~
   12 Simply the name of a module, represented as a FastString.
   13 These are Uniquable, hence we can build Maps with Modules as
   14 the keys.
   15 -}
   16 
   17 module GHC.Unit.Module
   18     ( module GHC.Unit.Types
   19 
   20       -- * The ModuleName type
   21     , module GHC.Unit.Module.Name
   22 
   23       -- * The ModLocation type
   24     , module GHC.Unit.Module.Location
   25 
   26       -- * ModuleEnv
   27     , module GHC.Unit.Module.Env
   28 
   29       -- * Generalization
   30     , getModuleInstantiation
   31     , getUnitInstantiations
   32     , uninstantiateInstantiatedUnit
   33     , uninstantiateInstantiatedModule
   34 
   35       -- * The Module type
   36     , mkHoleModule
   37     , isHoleModule
   38     , stableModuleCmp
   39     , moduleStableString
   40     , moduleIsDefinite
   41     , HasModule(..)
   42     , ContainsModule(..)
   43     , installedModuleEq
   44     ) where
   45 
   46 import GHC.Prelude
   47 
   48 import GHC.Types.Unique.DSet
   49 import GHC.Unit.Types
   50 import GHC.Unit.Module.Name
   51 import GHC.Unit.Module.Location
   52 import GHC.Unit.Module.Env
   53 import GHC.Utils.Misc
   54 
   55 -- | A 'Module' is definite if it has no free holes.
   56 moduleIsDefinite :: Module -> Bool
   57 moduleIsDefinite = isEmptyUniqDSet . moduleFreeHoles
   58 
   59 -- | Get a string representation of a 'Module' that's unique and stable
   60 -- across recompilations.
   61 -- eg. "$aeson_70dylHtv1FFGeai1IoxcQr$Data.Aeson.Types.Internal"
   62 moduleStableString :: Module -> String
   63 moduleStableString Module{..} =
   64   "$" ++ unitString moduleUnit ++ "$" ++ moduleNameString moduleName
   65 
   66 
   67 -- | This gives a stable ordering, as opposed to the Ord instance which
   68 -- gives an ordering based on the 'Unique's of the components, which may
   69 -- not be stable from run to run of the compiler.
   70 stableModuleCmp :: Module -> Module -> Ordering
   71 stableModuleCmp (Module p1 n1) (Module p2 n2)
   72    = (p1 `stableUnitCmp`  p2) `thenCmp`
   73      (n1 `stableModuleNameCmp` n2)
   74 
   75 class ContainsModule t where
   76     extractModule :: t -> Module
   77 
   78 class HasModule m where
   79     getModule :: m Module
   80 
   81 
   82 -- | Test if a 'Module' corresponds to a given 'InstalledModule',
   83 -- modulo instantiation.
   84 installedModuleEq :: InstalledModule -> Module -> Bool
   85 installedModuleEq imod mod =
   86     fst (getModuleInstantiation mod) == imod
   87 
   88 
   89 {-
   90 ************************************************************************
   91 *                                                                      *
   92                         Hole substitutions
   93 *                                                                      *
   94 ************************************************************************
   95 -}
   96 
   97 -- | Given a possibly on-the-fly instantiated module, split it into
   98 -- a 'Module' that we definitely can find on-disk, as well as an
   99 -- instantiation if we need to instantiate it on the fly.  If the
  100 -- instantiation is @Nothing@ no on-the-fly renaming is needed.
  101 getModuleInstantiation :: Module -> (InstalledModule, Maybe InstantiatedModule)
  102 getModuleInstantiation m =
  103     let (uid, mb_iuid) = getUnitInstantiations (moduleUnit m)
  104     in (Module uid (moduleName m),
  105         fmap (\iuid -> Module iuid (moduleName m)) mb_iuid)
  106 
  107 -- | Return the unit-id this unit is an instance of and the module instantiations (if any).
  108 getUnitInstantiations :: Unit -> (UnitId, Maybe InstantiatedUnit)
  109 getUnitInstantiations (VirtUnit iuid)           = (instUnitInstanceOf iuid, Just iuid)
  110 getUnitInstantiations (RealUnit (Definite uid)) = (uid, Nothing)
  111 getUnitInstantiations HoleUnit                  = error "Hole unit"
  112 
  113 -- | Remove instantiations of the given instantiated unit
  114 uninstantiateInstantiatedUnit :: InstantiatedUnit -> InstantiatedUnit
  115 uninstantiateInstantiatedUnit u =
  116     mkInstantiatedUnit (instUnitInstanceOf u)
  117                        (map (\(m,_) -> (m, mkHoleModule m))
  118                          (instUnitInsts u))
  119 
  120 -- | Remove instantiations of the given module instantiated unit
  121 uninstantiateInstantiatedModule :: InstantiatedModule -> InstantiatedModule
  122 uninstantiateInstantiatedModule (Module uid n) = Module (uninstantiateInstantiatedUnit uid) n
  123 
  124 -- | Test if a Module is not instantiated
  125 isHoleModule :: GenModule (GenUnit u) -> Bool
  126 isHoleModule (Module HoleUnit _) = True
  127 isHoleModule _                   = False
  128 
  129 -- | Create a hole Module
  130 mkHoleModule :: ModuleName -> GenModule (GenUnit u)
  131 mkHoleModule = Module HoleUnit