2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[HsDecls]{Abstract syntax: global declarations}
6 Definitions for: @TyDecl@ and @ConDecl@, @ClassDecl@,
7 @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
11 HsDecl(..), TyClDecl(..), InstDecl(..),
12 DefaultDecl(..), ForeignDecl(..), ForKind(..),
13 ExtName(..), isDynamic,
14 ConDecl(..), ConDetails(..), BangType(..),
15 IfaceSig(..), SpecDataSig(..), HsIdInfo(..), HsStrictnessInfo(..),
16 hsDeclName, tyClDeclName, isClassDecl, isSynDecl, isDataDecl, countTyClDecls
19 #include "HsVersions.h"
22 import HsBinds ( HsBinds, MonoBinds, Sig, FixitySig(..), nullMonoBinds )
23 import HsPragmas ( DataPragmas, ClassPragmas )
25 import HsCore ( UfExpr )
26 import BasicTypes ( Fixity, NewOrData(..) )
27 import IdInfo ( ArityInfo, UpdateInfo, InlinePragInfo )
28 import Demand ( Demand )
29 import CallConv ( CallConv, pprCallConv )
33 import SrcLoc ( SrcLoc )
38 %************************************************************************
40 \subsection[HsDecl]{Declarations}
42 %************************************************************************
46 = TyClD (TyClDecl name pat)
47 | InstD (InstDecl name pat)
48 | DefD (DefaultDecl name)
49 | ValD (HsBinds name pat)
50 | ForD (ForeignDecl name)
51 | SigD (IfaceSig name)
52 | FixD (FixitySig name)
54 -- NB: all top-level fixity decls are contained EITHER
56 -- OR in the ClassDecls in TyClDs
59 -- a) data constructors
60 -- b) class methods (but they can be also done in the
61 -- signatures of class decls)
62 -- c) imported functions (that have an IfacSig)
65 -- The latter is for class methods only
67 -- It's a bit wierd that the fixity decls in the ValD
68 -- cover all the classops and imported decls too, but it's convenient
69 -- For a start, it means we don't need a FixD
74 hsDeclName :: (Outputable name, Outputable pat)
75 => HsDecl name pat -> name
77 hsDeclName (TyClD decl) = tyClDeclName decl
78 hsDeclName (SigD (IfaceSig name _ _ _)) = name
79 hsDeclName (InstD (InstDecl _ _ _ (Just name) _)) = name
80 hsDeclName (ForD (ForeignDecl name _ _ _ _ _)) = name
81 hsDeclName (FixD (FixitySig name _ _)) = name
82 -- Others don't make sense
84 hsDeclName x = pprPanic "HsDecls.hsDeclName" (ppr x)
87 tyClDeclName :: TyClDecl name pat -> name
88 tyClDeclName (TyData _ _ name _ _ _ _ _) = name
89 tyClDeclName (TySynonym name _ _ _) = name
90 tyClDeclName (ClassDecl _ name _ _ _ _ _ _ _) = name
94 instance (Outputable name, Outputable pat)
95 => Outputable (HsDecl name pat) where
97 ppr (TyClD dcl) = ppr dcl
98 ppr (SigD sig) = ppr sig
99 ppr (ValD binds) = ppr binds
100 ppr (DefD def) = ppr def
101 ppr (InstD inst) = ppr inst
102 ppr (ForD fd) = ppr fd
103 ppr (FixD fd) = ppr fd
105 {- Why do we need ordering on decls?
108 -- hsDeclName needs more context when DEBUG is on
109 instance (Outputable name, Outputable pat, Eq name)
110 => Eq (HsDecl name pat) where
111 d1 == d2 = hsDeclName d1 == hsDeclName d2
113 instance (Outputable name, Outputable pat, Ord name)
114 => Ord (HsDecl name pat) where
115 d1 `compare` d2 = hsDeclName d1 `compare` hsDeclName d2
117 instance (Eq name) => Eq (HsDecl name pat) where
118 d1 == d2 = hsDeclName d1 == hsDeclName d2
120 instance (Ord name) => Ord (HsDecl name pat) where
121 d1 `compare` d2 = hsDeclName d1 `compare` hsDeclName d2
127 %************************************************************************
129 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
131 %************************************************************************
134 data TyClDecl name pat
136 (Context name) -- context
137 name -- type constructor
138 [HsTyVar name] -- type variables
139 [ConDecl name] -- data constructors (empty if abstract)
140 (Maybe [name]) -- derivings; Nothing => not specified
141 -- (i.e., derive default); Just [] => derive
142 -- *nothing*; Just <list> => as you would
147 | TySynonym name -- type constructor
148 [HsTyVar name] -- type variables
149 (HsType name) -- synonym expansion
152 | ClassDecl (Context name) -- context...
153 name -- name of the class
154 [HsTyVar name] -- the class type variables
155 [Sig name] -- methods' signatures
156 (MonoBinds name pat) -- default methods
158 name name -- The names of the tycon and datacon for this class
159 -- These are filled in by the renamer
164 countTyClDecls :: [TyClDecl name pat] -> (Int, Int, Int, Int)
165 -- class, data, newtype, synonym decls
167 = (length [() | ClassDecl _ _ _ _ _ _ _ _ _ <- decls],
168 length [() | TyData DataType _ _ _ _ _ _ _ <- decls],
169 length [() | TyData NewType _ _ _ _ _ _ _ <- decls],
170 length [() | TySynonym _ _ _ _ <- decls])
172 isDataDecl, isSynDecl, isClassDecl :: TyClDecl name pat -> Bool
174 isSynDecl (TySynonym _ _ _ _) = True
175 isSynDecl other = False
177 isDataDecl (TyData _ _ _ _ _ _ _ _) = True
178 isDataDecl other = False
180 isClassDecl (ClassDecl _ _ _ _ _ _ _ _ _) = True
181 isClassDecl other = False
185 instance (Outputable name, Outputable pat)
186 => Outputable (TyClDecl name pat) where
188 ppr (TySynonym tycon tyvars mono_ty src_loc)
189 = hang (pp_decl_head SLIT("type") empty tycon tyvars)
192 ppr (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
194 (pp_decl_head keyword (pprContext context) tycon tyvars)
195 (pp_condecls condecls)
198 keyword = case new_or_data of
199 NewType -> SLIT("newtype")
200 DataType -> SLIT("data")
202 ppr (ClassDecl context clas tyvars sigs methods pragmas _ _ src_loc)
203 | null sigs -- No "where" part
206 | otherwise -- Laid out
207 = sep [hsep [top_matter, ptext SLIT("where {")],
208 nest 4 (vcat [sep (map ppr_sig sigs),
212 top_matter = hsep [ptext SLIT("class"), pprContext context,
213 ppr clas, hsep (map (ppr) tyvars)]
214 ppr_sig sig = ppr sig <> semi
217 pp_decl_head str pp_context tycon tyvars
218 = hsep [ptext str, pp_context, ppr tycon,
219 interppSP tyvars, ptext SLIT("=")]
221 pp_condecls [] = empty -- Curious!
222 pp_condecls (c:cs) = sep (ppr c : map (\ c -> ptext SLIT("|") <+> ppr c) cs)
224 pp_tydecl pp_head pp_decl_rhs derivings
225 = hang pp_head 4 (sep [
229 Just ds -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
233 A type for recording what types a datatype should be specialised to.
234 It's called a ``Sig'' because it's sort of like a ``type signature''
235 for an datatype declaration.
238 data SpecDataSig name
239 = SpecDataSig name -- tycon to specialise
243 instance (Outputable name)
244 => Outputable (SpecDataSig name) where
246 ppr (SpecDataSig tycon ty _)
247 = hsep [text "{-# SPECIALIZE data", ppr ty, text "#-}"]
250 %************************************************************************
252 \subsection[ConDecl]{A data-constructor declaration}
254 %************************************************************************
258 = ConDecl name -- Constructor name
260 [HsTyVar name] -- Existentially quantified type variables
261 (Context name) -- ...and context
262 -- If both are empty then there are no existentials
268 = VanillaCon -- prefix-style con decl
271 | InfixCon -- infix-style con decl
275 | RecCon -- record-style con decl
276 [([name], BangType name)] -- list of "fields"
278 | NewCon -- newtype con decl, possibly with a labelled field.
280 (Maybe name) -- Just x => labelled field 'x'
283 = Banged (HsType name) -- HsType: to allow Haskell extensions
284 | Unbanged (HsType name) -- (MonoType only needed for straight Haskell)
285 | Unpacked (HsType name) -- Field is strict and to be unpacked if poss.
289 instance (Outputable name) => Outputable (ConDecl name) where
290 ppr (ConDecl con tvs cxt con_details loc)
291 = sep [pprForAll tvs, pprContext cxt, ppr_con_details con con_details]
293 ppr_con_details con (InfixCon ty1 ty2)
294 = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
296 ppr_con_details con (VanillaCon tys)
297 = ppr con <+> hsep (map (ppr_bang) tys)
299 ppr_con_details con (NewCon ty Nothing)
300 = ppr con <+> pprParendHsType ty
302 ppr_con_details con (NewCon ty (Just x))
303 = ppr con <+> braces pp_field
305 pp_field = ppr x <+> dcolon <+> pprParendHsType ty
307 ppr_con_details con (RecCon fields)
308 = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
310 ppr_field (ns, ty) = hsep (map (ppr) ns) <+>
314 ppr_bang (Banged ty) = ptext SLIT("!") <> pprParendHsType ty
315 ppr_bang (Unbanged ty) = pprParendHsType ty
316 ppr_bang (Unpacked ty) = ptext SLIT("! !") <> pprParendHsType ty
320 %************************************************************************
322 \subsection[InstDecl]{An instance declaration
324 %************************************************************************
327 data InstDecl name pat
328 = InstDecl (HsType name) -- Context => Class Instance-type
329 -- Using a polytype means that the renamer conveniently
330 -- figures out the quantified type variables for us.
334 [Sig name] -- User-supplied pragmatic info
336 (Maybe name) -- Name for the dictionary function
342 instance (Outputable name, Outputable pat)
343 => Outputable (InstDecl name pat) where
345 ppr (InstDecl inst_ty binds uprags dfun_name src_loc)
346 = getPprStyle $ \ sty ->
347 if ifaceStyle sty || (nullMonoBinds binds && null uprags) then
348 hsep [ptext SLIT("instance"), ppr inst_ty]
350 vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
356 %************************************************************************
358 \subsection[DefaultDecl]{A @default@ declaration}
360 %************************************************************************
362 There can only be one default declaration per module, but it is hard
363 for the parser to check that; we pass them all through in the abstract
364 syntax, and that restriction must be checked in the front end.
367 data DefaultDecl name
368 = DefaultDecl [HsType name]
371 instance (Outputable name)
372 => Outputable (DefaultDecl name) where
374 ppr (DefaultDecl tys src_loc)
375 = ptext SLIT("default") <+> parens (interpp'SP tys)
378 %************************************************************************
380 \subsection{Foreign function interface declaration}
382 %************************************************************************
385 data ForeignDecl name =
394 instance (Outputable name)
395 => Outputable (ForeignDecl name) where
397 ppr (ForeignDecl nm imp_exp ty ext_name cconv src_loc)
398 = ptext SLIT("foreign") <+> ppr_imp_exp <+> pprCallConv cconv <+>
399 ppr ext_name <+> ppr_unsafe <+> ppr nm <+> dcolon <+> ppr ty
401 (ppr_imp_exp, ppr_unsafe) =
403 FoLabel -> (ptext SLIT("label"), empty)
404 FoExport -> (ptext SLIT("export"), empty)
406 | us -> (ptext SLIT("import"), ptext SLIT("unsafe"))
407 | otherwise -> (ptext SLIT("import"), empty)
412 | FoImport Bool -- True => unsafe call.
416 | ExtName FAST_STRING (Maybe FAST_STRING)
418 isDynamic :: ExtName -> Bool
419 isDynamic Dynamic = True
423 instance Outputable ExtName where
424 ppr Dynamic = ptext SLIT("dynamic")
425 ppr (ExtName nm mb_mod) =
426 case mb_mod of { Nothing -> empty; Just m -> doubleQuotes (ptext m) } <+>
427 doubleQuotes (ptext nm)
431 %************************************************************************
433 \subsection{Signatures in interface files}
435 %************************************************************************
444 instance (Outputable name) => Outputable (IfaceSig name) where
445 ppr (IfaceSig var ty _ _)
446 = hang (hsep [ppr var, dcolon])
451 | HsStrictness (HsStrictnessInfo name)
452 | HsUnfold InlinePragInfo (Maybe (UfExpr name))
453 | HsUpdate UpdateInfo
454 | HsSpecialise [HsTyVar name] [HsType name] (UfExpr name)
458 data HsStrictnessInfo name
459 = HsStrictnessInfo ([Demand], Bool)
460 (Maybe (name, [name])) -- Worker, if any
461 -- and needed constructors