never executed always true always false
    1 
    2 
    3 module GHC.Types.Name.Ppr
    4    ( mkPrintUnqualified
    5    , mkQualModule
    6    , mkQualPackage
    7    , pkgQual
    8    )
    9 where
   10 
   11 import GHC.Prelude
   12 
   13 import GHC.Unit
   14 import GHC.Unit.Env
   15 
   16 import GHC.Core.TyCon
   17 
   18 import GHC.Types.Name
   19 import GHC.Types.Name.Reader
   20 
   21 import GHC.Builtin.Types
   22 
   23 import GHC.Utils.Outputable
   24 import GHC.Utils.Panic
   25 import GHC.Utils.Misc
   26 
   27 
   28 {-
   29 Note [Printing original names]
   30 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   31 Deciding how to print names is pretty tricky.  We are given a name
   32 P:M.T, where P is the package name, M is the defining module, and T is
   33 the occurrence name, and we have to decide in which form to display
   34 the name given a GlobalRdrEnv describing the current scope.
   35 
   36 Ideally we want to display the name in the form in which it is in
   37 scope.  However, the name might not be in scope at all, and that's
   38 where it gets tricky.  Here are the cases:
   39 
   40  1. T uniquely maps to  P:M.T      --->  "T"      NameUnqual
   41  2. There is an X for which X.T
   42        uniquely maps to  P:M.T     --->  "X.T"    NameQual X
   43  3. There is no binding for "M.T"  --->  "M.T"    NameNotInScope1
   44  4. Otherwise                      --->  "P:M.T"  NameNotInScope2
   45 
   46 (3) and (4) apply when the entity P:M.T is not in the GlobalRdrEnv at
   47 all. In these cases we still want to refer to the name as "M.T", *but*
   48 "M.T" might mean something else in the current scope (e.g. if there's
   49 an "import X as M"), so to avoid confusion we avoid using "M.T" if
   50 there's already a binding for it.  Instead we write P:M.T.
   51 
   52 There's one further subtlety: in case (3), what if there are two
   53 things around, P1:M.T and P2:M.T?  Then we don't want to print both of
   54 them as M.T!  However only one of the modules P1:M and P2:M can be
   55 exposed (say P2), so we use M.T for that, and P1:M.T for the other one.
   56 This is handled by the qual_mod component of PrintUnqualified, inside
   57 the (ppr mod) of case (3), in Name.pprModulePrefix
   58 
   59 Note [Printing unit ids]
   60 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
   61 In the old days, original names were tied to PackageIds, which directly
   62 corresponded to the entities that users wrote in Cabal files, and were perfectly
   63 suitable for printing when we need to disambiguate packages.  However, with
   64 instantiated units, the situation can be different: if the key is instantiated
   65 with some holes, we should try to give the user some more useful information.
   66 -}
   67 
   68 -- | Creates some functions that work out the best ways to format
   69 -- names for the user according to a set of heuristics.
   70 mkPrintUnqualified :: UnitEnv -> GlobalRdrEnv -> PrintUnqualified
   71 mkPrintUnqualified unit_env env
   72  = QueryQualify qual_name
   73       (mkQualModule unit_state home_unit)
   74       (mkQualPackage unit_state)
   75   where
   76   unit_state = ue_units unit_env
   77   home_unit  = ue_home_unit unit_env
   78   qual_name mod occ
   79         | [gre] <- unqual_gres
   80         , right_name gre
   81         = NameUnqual   -- If there's a unique entity that's in scope
   82                        -- unqualified with 'occ' AND that entity is
   83                        -- the right one, then we can use the unqualified name
   84 
   85         | [] <- unqual_gres
   86         , any is_name forceUnqualNames
   87         , not (isDerivedOccName occ)
   88         = NameUnqual   -- Don't qualify names that come from modules
   89                        -- that come with GHC, often appear in error messages,
   90                        -- but aren't typically in scope. Doing this does not
   91                        -- cause ambiguity, and it reduces the amount of
   92                        -- qualification in error messages thus improving
   93                        -- readability.
   94                        --
   95                        -- A motivating example is 'Constraint'. It's often not
   96                        -- in scope, but printing GHC.Prim.Constraint seems
   97                        -- overkill.
   98 
   99         | [gre] <- qual_gres
  100         = NameQual (greQualModName gre)
  101 
  102         | null qual_gres
  103         = if null (lookupGRE_RdrName (mkRdrQual (moduleName mod) occ) env)
  104           then NameNotInScope1
  105           else NameNotInScope2
  106 
  107         | otherwise
  108         = NameNotInScope1   -- Can happen if 'f' is bound twice in the module
  109                             -- Eg  f = True; g = 0; f = False
  110       where
  111         is_name :: Name -> Bool
  112         is_name name = assertPpr (isExternalName name) (ppr name) $
  113                        nameModule name == mod && nameOccName name == occ
  114 
  115         forceUnqualNames :: [Name]
  116         forceUnqualNames =
  117           map tyConName [ constraintKindTyCon, heqTyCon, coercibleTyCon ]
  118           ++ [ eqTyConName ]
  119 
  120         right_name gre = greDefinitionModule gre == Just mod
  121 
  122         unqual_gres = lookupGRE_RdrName (mkRdrUnqual occ) env
  123         qual_gres   = filter right_name (lookupGlobalRdrEnv env occ)
  124 
  125     -- we can mention a module P:M without the P: qualifier iff
  126     -- "import M" would resolve unambiguously to P:M.  (if P is the
  127     -- current package we can just assume it is unqualified).
  128 
  129 -- | Creates a function for formatting modules based on two heuristics:
  130 -- (1) if the module is the current module, don't qualify, and (2) if there
  131 -- is only one exposed package which exports this module, don't qualify.
  132 mkQualModule :: UnitState -> Maybe HomeUnit -> QueryQualifyModule
  133 mkQualModule unit_state mhome_unit mod
  134      | Just home_unit <- mhome_unit
  135      , isHomeModule home_unit mod = False
  136 
  137      | [(_, pkgconfig)] <- lookup,
  138        mkUnit pkgconfig == moduleUnit mod
  139         -- this says: we are given a module P:M, is there just one exposed package
  140         -- that exposes a module M, and is it package P?
  141      = False
  142 
  143      | otherwise = True
  144      where lookup = lookupModuleInAllUnits unit_state (moduleName mod)
  145 
  146 -- | Creates a function for formatting packages based on two heuristics:
  147 -- (1) don't qualify if the package in question is "main", and (2) only qualify
  148 -- with a unit id if the package ID would be ambiguous.
  149 mkQualPackage :: UnitState -> QueryQualifyPackage
  150 mkQualPackage pkgs uid
  151      | uid == mainUnit || uid == interactiveUnit
  152         -- Skip the lookup if it's main, since it won't be in the package
  153         -- database!
  154      = False
  155      | Just pkgid <- mb_pkgid
  156      , searchPackageId pkgs pkgid `lengthIs` 1
  157         -- this says: we are given a package pkg-0.1@MMM, are there only one
  158         -- exposed packages whose package ID is pkg-0.1?
  159      = False
  160      | otherwise
  161      = True
  162      where mb_pkgid = fmap unitPackageId (lookupUnit pkgs uid)
  163 
  164 -- | A function which only qualifies package names if necessary; but
  165 -- qualifies all other identifiers.
  166 pkgQual :: UnitState -> PrintUnqualified
  167 pkgQual pkgs = alwaysQualify { queryQualifyPackage = mkQualPackage pkgs }