2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[TyCon]{The @TyCon@ datatype}
7 #include "HsVersions.h"
10 TyCon(..), -- NB: some pals need to see representation
12 Arity(..), NewOrData(..),
14 isFunTyCon, isPrimTyCon, isBoxedTyCon,
15 isDataTyCon, isSynTyCon,
31 tyConArity, synTyConArity,
39 CHK_Ubiq() -- debugging consistency check
40 import NameLoop -- for paranoia checking
42 import TyLoop ( Type(..), GenType,
45 mkTupleCon, dataConSig,
49 import TyVar ( GenTyVar, alphaTyVars, alphaTyVar, betaTyVar )
50 import Usage ( GenUsage, Usage(..) )
51 import Kind ( Kind, mkBoxedTypeKind, mkArrowKind, resultKind, argKind )
52 import PrelMods ( pRELUDE_BUILTIN )
55 import NameTypes ( FullName )
56 import Unique ( Unique, funTyConKey, mkTupleTyConUnique )
58 import Pretty ( Pretty(..), PrettyRep )
59 import PprStyle ( PprStyle )
60 import SrcLoc ( SrcLoc, mkBuiltinSrcLoc )
61 import Util ( panic, panic#, nOfThem, isIn, Ord3(..) )
68 = FunTyCon -- Kind = Type -> Type -> Type
70 | DataTyCon Unique{-TyConKey-}
74 [(Class,Type)] -- Its context
75 [Id] -- Its data constructors, with fully polymorphic types
76 [Class] -- Classes which have derived instances
79 | TupleTyCon Arity -- just a special case of DataTyCon
80 -- Kind = BoxedTypeKind
81 -- -> ... (n times) ...
85 | PrimTyCon -- Primitive types; cannot be defined in Haskell
86 Unique -- Always unboxed; hence never represented by a closure
87 FullName -- Often represented by a bit-pattern for the thing
88 Kind -- itself (eg Int#), but sometimes by a pointer to
90 | SpecTyCon -- A specialised TyCon; eg (Arr# Int#), or (List Int#)
92 [Maybe Type] -- Specialising types
94 -- OLD STUFF ABOUT Array types. Use SpecTyCon instead
95 -- ([PrimRep] -> PrimRep) -- a heap-allocated object (eg ArrInt#).
96 -- The primitive types Arr# and StablePtr# have
97 -- parameters (hence arity /= 0); but the rest don't.
98 -- Only arrays use the list in a non-trivial way.
99 -- Length of that list must == arity.
106 [TyVar] -- Argument type variables
107 Type -- Right-hand side, mentioning these type vars.
108 -- Acts as a template for the expansion when
109 -- the tycon is applied to some types.
112 = NewType -- "newtype Blah ..."
113 | DataType -- "data Blah ..."
117 mkFunTyCon = FunTyCon
118 mkDataTyCon = DataTyCon
119 mkTupleTyCon = TupleTyCon
120 mkPrimTyCon = PrimTyCon
121 mkSpecTyCon = SpecTyCon
122 mkSynTyCon = SynTyCon
124 isFunTyCon FunTyCon = True
127 isPrimTyCon (PrimTyCon _ _ _) = True
128 isPrimTyCon _ = False
130 -- At present there are no unboxed non-primitive types, so
131 -- isBoxedTyCon is just the negation of isPrimTyCon.
132 isBoxedTyCon = not . isPrimTyCon
134 -- isDataTyCon returns False for @newtype@.
135 -- Not sure about this decision yet.
136 isDataTyCon (DataTyCon _ _ _ _ _ _ _ DataType) = True
137 isDataTyCon other = False
139 isSynTyCon (SynTyCon _ _ _ _ _ _) = True
144 -- Special cases to avoid reconstructing lots of kinds
145 kind1 = mkBoxedTypeKind `mkArrowKind` mkBoxedTypeKind
146 kind2 = mkBoxedTypeKind `mkArrowKind` kind1
148 tyConKind :: TyCon -> Kind
149 tyConKind FunTyCon = kind2
150 tyConKind (DataTyCon _ kind _ _ _ _ _ _) = kind
151 tyConKind (PrimTyCon _ _ kind) = kind
153 tyConKind (SpecTyCon tc tys)
154 = spec (tyConKind tc) tys
157 spec kind (Just _ : tys) = spec (resultKind kind) tys
158 spec kind (Nothing : tys) =
159 argKind kind `mkArrowKind` spec (resultKind kind) tys
161 tyConKind (TupleTyCon n)
164 mkArrow 0 = mkBoxedTypeKind
167 mkArrow n = mkBoxedTypeKind `mkArrowKind` mkArrow (n-1)
171 tyConUnique :: TyCon -> Unique
172 tyConUnique FunTyCon = funTyConKey
173 tyConUnique (DataTyCon uniq _ _ _ _ _ _ _) = uniq
174 tyConUnique (TupleTyCon a) = mkTupleTyConUnique a
175 tyConUnique (PrimTyCon uniq _ _) = uniq
176 tyConUnique (SynTyCon uniq _ _ _ _ _) = uniq
177 tyConUnique (SpecTyCon _ _ ) = panic "tyConUnique:SpecTyCon"
179 tyConArity :: TyCon -> Arity
180 tyConArity FunTyCon = 2
181 tyConArity (DataTyCon _ _ _ tvs _ _ _ _) = length tvs
182 tyConArity (TupleTyCon arity) = arity
183 tyConArity (PrimTyCon _ _ _) = 0 -- ??
184 tyConArity (SpecTyCon _ _) = 0
185 tyConArity (SynTyCon _ _ _ arity _ _) = arity
187 synTyConArity :: TyCon -> Maybe Arity -- Nothing <=> not a syn tycon
188 synTyConArity (SynTyCon _ _ _ arity _ _) = Just arity
189 synTyConArity _ = Nothing
193 tyConTyVars :: TyCon -> [TyVar]
194 tyConTyVars FunTyCon = [alphaTyVar,betaTyVar]
195 tyConTyVars (DataTyCon _ _ _ tvs _ _ _ _) = tvs
196 tyConTyVars (TupleTyCon arity) = take arity alphaTyVars
197 tyConTyVars (SynTyCon _ _ _ _ tvs _) = tvs
198 tyConTyVars (PrimTyCon _ _ _) = panic "tyConTyVars:PrimTyCon"
199 tyConTyVars (SpecTyCon _ _ ) = panic "tyConTyVars:SpecTyCon"
203 tyConDataCons :: TyCon -> [Id]
204 tyConFamilySize :: TyCon -> Int
206 tyConDataCons (DataTyCon _ _ _ _ _ data_cons _ _) = data_cons
207 tyConDataCons (TupleTyCon a) = [mkTupleCon a]
208 tyConDataCons other = []
209 -- You may think this last equation should fail,
210 -- but it's quite convenient to return no constructors for
211 -- a synonym; see for example the call in TcTyClsDecls.
213 tyConFamilySize (DataTyCon _ _ _ _ _ data_cons _ _) = length data_cons
214 tyConFamilySize (TupleTyCon a) = 1
218 tyConDerivings :: TyCon -> [Class]
219 tyConDerivings (DataTyCon _ _ _ _ _ _ derivs _) = derivs
220 tyConDerivings other = []
224 getSynTyConDefn :: TyCon -> ([TyVar], Type)
225 getSynTyConDefn (SynTyCon _ _ _ _ tyvars ty) = (tyvars,ty)
229 maybeTyConSingleCon :: TyCon -> Maybe Id
230 maybeTyConSingleCon (TupleTyCon arity) = Just (mkTupleCon arity)
231 maybeTyConSingleCon (DataTyCon _ _ _ _ _ [c] _ _) = Just c
232 maybeTyConSingleCon (DataTyCon _ _ _ _ _ _ _ _) = Nothing
233 maybeTyConSingleCon (PrimTyCon _ _ _) = Nothing
234 maybeTyConSingleCon (SpecTyCon tc tys) = panic "maybeTyConSingleCon:SpecTyCon"
235 -- requires DataCons of TyCon
237 isEnumerationTyCon (TupleTyCon arity)
239 isEnumerationTyCon (DataTyCon _ _ _ _ _ data_cons _ _)
240 = not (null data_cons) && all is_nullary data_cons
242 is_nullary con = case (dataConSig con) of { (_,_, arg_tys, _) ->
246 @derivedFor@ reports if we have an {\em obviously}-derived instance
247 for the given class/tycon. Of course, you might be deriving something
248 because it a superclass of some other obviously-derived class --- this
249 function doesn't deal with that.
251 ToDo: what about derivings for specialised tycons !!!
254 derivedFor :: Class -> TyCon -> Bool
255 derivedFor clas (DataTyCon _ _ _ _ _ _ derivs _) = isIn "derivedFor" clas derivs
256 derivedFor clas something_weird = False
259 %************************************************************************
261 \subsection[TyCon-instances]{Instance declarations for @TyCon@}
263 %************************************************************************
265 @TyCon@s are compared by comparing their @Unique@s.
267 The strictness analyser needs @Ord@. It is a lexicographic order with
268 the property @(a<=b) || (b<=a)@.
271 instance Ord3 TyCon where
272 cmp FunTyCon FunTyCon = EQ_
273 cmp (DataTyCon a _ _ _ _ _ _ _) (DataTyCon b _ _ _ _ _ _ _) = a `cmp` b
274 cmp (SynTyCon a _ _ _ _ _) (SynTyCon b _ _ _ _ _) = a `cmp` b
275 cmp (TupleTyCon a) (TupleTyCon b) = a `cmp` b
276 cmp (PrimTyCon a _ _) (PrimTyCon b _ _) = a `cmp` b
277 cmp (SpecTyCon tc1 mtys1) (SpecTyCon tc2 mtys2)
278 = panic# "cmp on SpecTyCons" -- case (tc1 `cmp` tc2) of { EQ_ -> mtys1 `cmp` mtys2; xxx -> xxx }
280 -- now we *know* the tags are different, so...
282 | tag1 _LT_ tag2 = LT_
285 tag1 = tag_TyCon other_1
286 tag2 = tag_TyCon other_2
287 tag_TyCon FunTyCon = ILIT(1)
288 tag_TyCon (DataTyCon _ _ _ _ _ _ _ _) = ILIT(2)
289 tag_TyCon (TupleTyCon _) = ILIT(3)
290 tag_TyCon (PrimTyCon _ _ _) = ILIT(4)
291 tag_TyCon (SpecTyCon _ _) = ILIT(5)
293 instance Eq TyCon where
294 a == b = case (a `cmp` b) of { EQ_ -> True; _ -> False }
295 a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
297 instance Ord TyCon where
298 a <= b = case (a `cmp` b) of { LT_ -> True; EQ_ -> True; GT__ -> False }
299 a < b = case (a `cmp` b) of { LT_ -> True; EQ_ -> False; GT__ -> False }
300 a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True; GT__ -> True }
301 a > b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True }
302 _tagCmp a b = case (a `cmp` b) of { LT_ -> _LT; EQ_ -> _EQ; GT__ -> _GT }
306 instance NamedThing TyCon where
307 getExportFlag tc = case get_name tc of
308 Nothing -> NotExported
309 Just name -> getExportFlag name
312 isLocallyDefined tc = case get_name tc of
314 Just name -> isLocallyDefined name
316 getOrigName FunTyCon = (pRELUDE_BUILTIN, SLIT("(->)"))
317 getOrigName (TupleTyCon a) = (pRELUDE_BUILTIN, _PK_ ("Tuple" ++ show a))
318 getOrigName (SpecTyCon tc tys) = let (m,n) = getOrigName tc in
319 (m, n _APPEND_ specMaybeTysSuffix tys)
320 getOrigName other_tc = getOrigName (expectJust "tycon1" (get_name other_tc))
322 getOccurrenceName FunTyCon = SLIT("(->)")
323 getOccurrenceName (TupleTyCon 0) = SLIT("()")
324 getOccurrenceName (TupleTyCon a) = _PK_ ( "(" ++ nOfThem (a-1) ',' ++ ")" )
325 getOccurrenceName (SpecTyCon tc tys)= getOccurrenceName tc _APPEND_ specMaybeTysSuffix tys
326 getOccurrenceName other_tc = getOccurrenceName (expectJust "tycon2" (get_name other_tc))
328 getInformingModules tc = case get_name tc of
329 Nothing -> panic "getInformingModule:TyCon"
330 Just name -> getInformingModules name
332 getSrcLoc tc = case get_name tc of
333 Nothing -> mkBuiltinSrcLoc
334 Just name -> getSrcLoc name
336 getItsUnique tycon = tyConUnique tycon
338 fromPreludeCore tc = case get_name tc of
340 Just name -> fromPreludeCore name
343 Emphatically un-exported:
346 get_name (DataTyCon _ _ n _ _ _ _ _) = Just n
347 get_name (PrimTyCon _ n _) = Just n
348 get_name (SpecTyCon tc _) = get_name tc
349 get_name (SynTyCon _ n _ _ _ _) = Just n
350 get_name other = Nothing