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 }