Make derived names deterministic
[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 ) where
13
14 import Name
15 import NameEnv
16 import NameSet
17
18 import Binary
19 import Outputable
20 import Util
21
22 -- -----------------------------------------------------------------------------
23 -- The AvailInfo type
24
25 -- | Records what things are "available", i.e. in scope
26 data AvailInfo = Avail Name -- ^ An ordinary identifier in scope
27 | AvailTC Name
28 [Name] -- ^ A type or class in scope. Parameters:
29 --
30 -- 1) The name of the type or class
31 -- 2) The available pieces of type or class.
32 --
33 -- The AvailTC Invariant:
34 -- * If the type or class is itself
35 -- to be in scope, it must be
36 -- *first* in this list. Thus,
37 -- typically: @AvailTC Eq [Eq, ==, \/=]@
38 deriving( Eq )
39 -- Equality used when deciding if the
40 -- interface has changed
41
42 -- | A collection of 'AvailInfo' - several things that are \"available\"
43 type Avails = [AvailInfo]
44
45 -- | Compare lexicographically
46 stableAvailCmp :: AvailInfo -> AvailInfo -> Ordering
47 stableAvailCmp (Avail n1) (Avail n2) = n1 `stableNameCmp` n2
48 stableAvailCmp (Avail {}) (AvailTC {}) = LT
49 stableAvailCmp (AvailTC n ns) (AvailTC m ms) = (n `stableNameCmp` m) `thenCmp`
50 (cmpList stableNameCmp ns ms)
51 stableAvailCmp (AvailTC {}) (Avail {}) = GT
52
53
54 -- -----------------------------------------------------------------------------
55 -- Operations on AvailInfo
56
57 availsToNameSet :: [AvailInfo] -> NameSet
58 availsToNameSet avails = foldr add emptyNameSet avails
59 where add avail set = extendNameSetList set (availNames avail)
60
61 availsToNameEnv :: [AvailInfo] -> NameEnv AvailInfo
62 availsToNameEnv avails = foldr add emptyNameEnv avails
63 where add avail env = extendNameEnvList env
64 (zip (availNames avail) (repeat avail))
65
66 -- | Just the main name made available, i.e. not the available pieces
67 -- of type or class brought into scope by the 'GenAvailInfo'
68 availName :: AvailInfo -> Name
69 availName (Avail n) = n
70 availName (AvailTC n _) = n
71
72 -- | All names made available by the availability information
73 availNames :: AvailInfo -> [Name]
74 availNames (Avail n) = [n]
75 availNames (AvailTC _ ns) = ns
76
77 -- -----------------------------------------------------------------------------
78 -- Printing
79
80 instance Outputable AvailInfo where
81 ppr = pprAvail
82
83 pprAvail :: AvailInfo -> SDoc
84 pprAvail (Avail n) = ppr n
85 pprAvail (AvailTC n ns) = ppr n <> braces (hsep (punctuate comma (map ppr ns)))
86
87 instance Binary AvailInfo where
88 put_ bh (Avail aa) = do
89 putByte bh 0
90 put_ bh aa
91 put_ bh (AvailTC ab ac) = do
92 putByte bh 1
93 put_ bh ab
94 put_ bh ac
95 get bh = do
96 h <- getByte bh
97 case h of
98 0 -> do aa <- get bh
99 return (Avail aa)
100 _ -> do ab <- get bh
101 ac <- get bh
102 return (AvailTC ab ac)
103