Comments only
[ghc.git] / compiler / basicTypes / Avail.hs
1 --
2 -- (c) The University of Glasgow
3 --
4
5 module Avail (
6 Avails,
7 AvailInfo(..),
8 availsToNameSet,
9 availsToNameEnv,
10 availName, availNames,
11 stableAvailCmp,
12 gresFromAvails,
13 gresFromAvail
14 ) where
15
16 import Name
17 import NameEnv
18 import NameSet
19 import RdrName
20
21 import Binary
22 import Outputable
23 import Util
24
25 -- -----------------------------------------------------------------------------
26 -- The AvailInfo type
27
28 -- | Records what things are "available", i.e. in scope
29 data AvailInfo = Avail Name -- ^ An ordinary identifier in scope
30 | AvailTC Name
31 [Name] -- ^ A type or class in scope. Parameters:
32 --
33 -- 1) The name of the type or class
34 -- 2) The available pieces of type or class.
35 --
36 -- The AvailTC Invariant:
37 -- * If the type or class is itself
38 -- to be in scope, it must be
39 -- *first* in this list. Thus,
40 -- typically: @AvailTC Eq [Eq, ==, \/=]@
41 deriving( Eq )
42 -- Equality used when deciding if the
43 -- interface has changed
44
45 -- | A collection of 'AvailInfo' - several things that are \"available\"
46 type Avails = [AvailInfo]
47
48 -- | Compare lexicographically
49 stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
50 stableAvailCmp (Avail n1) (Avail n2) = n1 `stableNameCmp` n2
51 stableAvailCmp (Avail {}) (AvailTC {}) = LT
52 stableAvailCmp (AvailTC n ns) (AvailTC m ms) = (n `stableNameCmp` m) `thenCmp`
53 (cmpList stableNameCmp ns ms)
54 stableAvailCmp (AvailTC {}) (Avail {}) = GT
55
56
57 -- -----------------------------------------------------------------------------
58 -- Operations on AvailInfo
59
60 availsToNameSet :: [AvailInfo] -> NameSet
61 availsToNameSet avails = foldr add emptyNameSet avails
62 where add avail set = addListToNameSet set (availNames avail)
63
64 availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
65 availsToNameEnv avails = foldr add emptyNameEnv avails
66 where add avail env = extendNameEnvList env
67 (zip (availNames avail) (repeat avail))
68
69 -- | Just the main name made available, i.e. not the available pieces
70 -- of type or class brought into scope by the 'GenAvailInfo'
71 availName :: AvailInfo -> Name
72 availName (Avail n) = n
73 availName (AvailTC n _) = n
74
75 -- | All names made available by the availability information
76 availNames :: AvailInfo -> [Name]
77 availNames (Avail n) = [n]
78 availNames (AvailTC _ ns) = ns
79
80 -- | make a 'GlobalRdrEnv' where all the elements point to the same
81 -- Provenance (useful for "hiding" imports, or imports with
82 -- no details).
83 gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
84 gresFromAvails prov avails
85 = concatMap (gresFromAvail (const prov)) avails
86
87 gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
88 gresFromAvail prov_fn avail
89 = [ GRE {gre_name = n,
90 gre_par = parent n avail,
91 gre_prov = prov_fn n}
92 | n <- availNames avail ]
93 where
94 parent _ (Avail _) = NoParent
95 parent n (AvailTC m _) | n == m = NoParent
96 | otherwise = ParentIs m
97
98 -- -----------------------------------------------------------------------------
99 -- Printing
100
101 instance Outputable AvailInfo where
102 ppr = pprAvail
103
104 pprAvail :: AvailInfo -> SDoc
105 pprAvail (Avail n) = ppr n
106 pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns)))
107
108 instance Binary AvailInfo where
109 put_ bh (Avail aa) = do
110 putByte bh 0
111 put_ bh aa
112 put_ bh (AvailTC ab ac) = do
113 putByte bh 1
114 put_ bh ab
115 put_ bh ac
116 get bh = do
117 h <- getByte bh
118 case h of
119 0 -> do aa <- get bh
120 return (Avail aa)
121 _ -> do ab <- get bh
122 ac <- get bh
123 return (AvailTC ab ac)
124