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)
288 instance (Outputable name) => Outputable (ConDecl name) where
289 ppr (ConDecl con tvs cxt con_details loc)
290 = sep [pprForAll tvs, pprContext cxt, ppr_con_details con con_details]
292 ppr_con_details con (InfixCon ty1 ty2)
293 = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
295 ppr_con_details con (VanillaCon tys)
296 = ppr con <+> hsep (map (ppr_bang) tys)
298 ppr_con_details con (NewCon ty Nothing)
299 = ppr con <+> pprParendHsType ty
301 ppr_con_details con (NewCon ty (Just x))
302 = ppr con <+> braces pp_field
304 pp_field = ppr x <+> dcolon <+> pprParendHsType ty
306 ppr_con_details con (RecCon fields)
307 = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
309 ppr_field (ns, ty) = hsep (map (ppr) ns) <+>
313 ppr_bang (Banged ty) = ptext SLIT("!") <> pprParendHsType ty
314 ppr_bang (Unbanged ty) = pprParendHsType ty
318 %************************************************************************
320 \subsection[InstDecl]{An instance declaration
322 %************************************************************************
325 data InstDecl name pat
326 = InstDecl (HsType name) -- Context => Class Instance-type
327 -- Using a polytype means that the renamer conveniently
328 -- figures out the quantified type variables for us.
332 [Sig name] -- User-supplied pragmatic info
334 (Maybe name) -- Name for the dictionary function
340 instance (Outputable name, Outputable pat)
341 => Outputable (InstDecl name pat) where
343 ppr (InstDecl inst_ty binds uprags dfun_name src_loc)
344 = getPprStyle $ \ sty ->
345 if ifaceStyle sty || (nullMonoBinds binds && null uprags) then
346 hsep [ptext SLIT("instance"), ppr inst_ty]
348 vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
354 %************************************************************************
356 \subsection[DefaultDecl]{A @default@ declaration}
358 %************************************************************************
360 There can only be one default declaration per module, but it is hard
361 for the parser to check that; we pass them all through in the abstract
362 syntax, and that restriction must be checked in the front end.
365 data DefaultDecl name
366 = DefaultDecl [HsType name]
369 instance (Outputable name)
370 => Outputable (DefaultDecl name) where
372 ppr (DefaultDecl tys src_loc)
373 = ptext SLIT("default") <+> parens (interpp'SP tys)
376 %************************************************************************
378 \subsection{Foreign function interface declaration}
380 %************************************************************************
383 data ForeignDecl name =
392 instance (Outputable name)
393 => Outputable (ForeignDecl name) where
395 ppr (ForeignDecl nm imp_exp ty ext_name cconv src_loc)
396 = ptext SLIT("foreign") <+> ppr_imp_exp <+> pprCallConv cconv <+>
397 ppr ext_name <+> ppr_unsafe <+> ppr nm <+> dcolon <+> ppr ty
399 (ppr_imp_exp, ppr_unsafe) =
401 FoLabel -> (ptext SLIT("label"), empty)
402 FoExport -> (ptext SLIT("export"), empty)
404 | us -> (ptext SLIT("import"), ptext SLIT("unsafe"))
405 | otherwise -> (ptext SLIT("import"), empty)
410 | FoImport Bool -- True => unsafe call.
414 | ExtName FAST_STRING (Maybe FAST_STRING)
416 isDynamic :: ExtName -> Bool
417 isDynamic Dynamic = True
421 instance Outputable ExtName where
422 ppr Dynamic = ptext SLIT("dynamic")
423 ppr (ExtName nm mb_mod) =
424 case mb_mod of { Nothing -> empty; Just m -> doubleQuotes (ptext m) } <+>
425 doubleQuotes (ptext nm)
429 %************************************************************************
431 \subsection{Signatures in interface files}
433 %************************************************************************
442 instance (Outputable name) => Outputable (IfaceSig name) where
443 ppr (IfaceSig var ty _ _)
444 = hang (hsep [ppr var, dcolon])
449 | HsStrictness (HsStrictnessInfo name)
450 | HsUnfold InlinePragInfo (Maybe (UfExpr name))
451 | HsUpdate UpdateInfo
452 | HsSpecialise [HsTyVar name] [HsType name] (UfExpr name)
456 data HsStrictnessInfo name
457 = HsStrictnessInfo ([Demand], Bool)
458 (Maybe (name, [name])) -- Worker, if any
459 -- and needed constructors