2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[HsDecls]{Abstract syntax: global declarations}
6 Definitions for: @FixityDecl@, @TyDecl@ and @ConDecl@, @ClassDecl@,
7 @InstDecl@, @DefaultDecl@.
12 #include "HsVersions.h"
15 import HsBinds ( HsBinds, MonoBinds, Sig, nullMonoBinds )
16 import HsPragmas ( DataPragmas, ClassPragmas )
18 import HsCore ( UfExpr )
19 import BasicTypes ( Fixity, NewOrData(..) )
20 import IdInfo ( ArgUsageInfo, FBTypeInfo, ArityInfo, UpdateInfo )
21 import Demand ( Demand )
24 import Name ( getOccName, OccName, NamedThing(..) )
26 import SrcLoc ( SrcLoc )
31 %************************************************************************
33 \subsection[HsDecl]{Declarations}
35 %************************************************************************
38 data HsDecl flexi name pat
40 | ClD (ClassDecl flexi name pat)
41 | InstD (InstDecl flexi name pat)
42 | DefD (DefaultDecl name)
43 | ValD (HsBinds flexi name pat)
44 | SigD (IfaceSig name)
49 hsDeclName :: (NamedThing name, Outputable name, Outputable pat)
50 => HsDecl flexi name pat -> name
52 hsDeclName (TyD (TyData _ _ name _ _ _ _ _)) = name
53 hsDeclName (TyD (TySynonym name _ _ _)) = name
54 hsDeclName (ClD (ClassDecl _ name _ _ _ _ _ _ _)) = name
55 hsDeclName (SigD (IfaceSig name _ _ _)) = name
56 hsDeclName (InstD (InstDecl _ _ _ (Just name) _)) = name
57 -- Others don't make sense
59 hsDeclName x = pprPanic "HsDecls.hsDeclName" (ppr x)
64 instance (NamedThing name, Outputable name, Outputable pat)
65 => Outputable (HsDecl flexi name pat) where
69 ppr (SigD sig) = ppr sig
70 ppr (ValD binds) = ppr binds
71 ppr (DefD def) = ppr def
72 ppr (InstD inst) = ppr inst
75 -- hsDeclName needs more context when DEBUG is on
76 instance (NamedThing name, Outputable name, Outputable pat, Eq name)
77 => Eq (HsDecl flex name pat) where
78 d1 == d2 = hsDeclName d1 == hsDeclName d2
80 instance (NamedThing name, Outputable name, Outputable pat, Ord name)
81 => Ord (HsDecl flex name pat) where
82 d1 `compare` d2 = hsDeclName d1 `compare` hsDeclName d2
84 instance (Eq name) => Eq (HsDecl flex name pat) where
85 d1 == d2 = hsDeclName d1 == hsDeclName d2
87 instance (Ord name) => Ord (HsDecl flexi name pat) where
88 d1 `compare` d2 = hsDeclName d1 `compare` hsDeclName d2
93 %************************************************************************
95 \subsection[FixityDecl]{A fixity declaration}
97 %************************************************************************
100 data FixityDecl name = FixityDecl name Fixity SrcLoc
102 instance Outputable name => Outputable (FixityDecl name) where
103 ppr (FixityDecl name fixity loc) = sep [ppr fixity, ppr name]
107 %************************************************************************
109 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
111 %************************************************************************
116 (Context name) -- context
117 name -- type constructor
118 [HsTyVar name] -- type variables
119 [ConDecl name] -- data constructors (empty if abstract)
120 (Maybe [name]) -- derivings; Nothing => not specified
121 -- (i.e., derive default); Just [] => derive
122 -- *nothing*; Just <list> => as you would
127 | TySynonym name -- type constructor
128 [HsTyVar name] -- type variables
129 (HsType name) -- synonym expansion
135 instance (NamedThing name, Outputable name)
136 => Outputable (TyDecl name) where
138 ppr (TySynonym tycon tyvars mono_ty src_loc)
139 = hang (pp_decl_head SLIT("type") empty tycon tyvars)
142 ppr (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
144 (pp_decl_head keyword (pp_context_and_arrow context) tycon tyvars)
145 (pp_condecls condecls)
148 keyword = case new_or_data of
149 NewType -> SLIT("newtype")
150 DataType -> SLIT("data")
152 pp_decl_head str pp_context tycon tyvars
153 = hsep [ptext str, pp_context, ppr tycon,
154 interppSP tyvars, ptext SLIT("=")]
156 pp_condecls [] = empty -- Curious!
158 = sep (ppr c : map (\ c -> (<>) (ptext SLIT("| ")) (ppr c)) cs)
160 pp_tydecl pp_head pp_decl_rhs derivings
161 = hang pp_head 4 (sep [
165 Just ds -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
168 pp_context_and_arrow :: Outputable name => Context name -> SDoc
169 pp_context_and_arrow [] = empty
170 pp_context_and_arrow theta = hsep [pprContext theta, ptext SLIT("=>")]
173 A type for recording what types a datatype should be specialised to.
174 It's called a ``Sig'' because it's sort of like a ``type signature''
175 for an datatype declaration.
178 data SpecDataSig name
179 = SpecDataSig name -- tycon to specialise
183 instance (NamedThing name, Outputable name)
184 => Outputable (SpecDataSig name) where
186 ppr (SpecDataSig tycon ty _)
187 = hsep [text "{-# SPECIALIZE data", ppr ty, text "#-}"]
190 %************************************************************************
192 \subsection[ConDecl]{A data-constructor declaration}
194 %************************************************************************
198 = ConDecl name -- Constructor name
199 (Context name) -- Existential context for this constructor
204 = VanillaCon -- prefix-style con decl
207 | InfixCon -- infix-style con decl
211 | RecCon -- record-style con decl
212 [([name], BangType name)] -- list of "fields"
214 | NewCon -- newtype con decl
218 = Banged (HsType name) -- HsType: to allow Haskell extensions
219 | Unbanged (HsType name) -- (MonoType only needed for straight Haskell)
223 instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where
224 ppr (ConDecl con cxt con_details loc)
225 = pp_context_and_arrow cxt <+> ppr_con_details con con_details
227 ppr_con_details con (InfixCon ty1 ty2)
228 = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
230 ppr_con_details con (VanillaCon tys)
231 = ppr con <+> hsep (map (ppr_bang) tys)
233 ppr_con_details con (NewCon ty)
234 = ppr con <+> pprParendHsType ty
236 ppr_con_details con (RecCon fields)
237 = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
239 ppr_field (ns, ty) = hsep (map (ppr) ns) <+>
243 ppr_bang (Banged ty) = ptext SLIT("!") <> pprParendHsType ty
244 ppr_bang (Unbanged ty) = pprParendHsType ty
247 %************************************************************************
249 \subsection[ClassDecl]{A class declaration}
251 %************************************************************************
254 data ClassDecl flexi name pat
255 = ClassDecl (Context name) -- context...
256 name -- name of the class
257 [HsTyVar name] -- the class type variables
258 [Sig name] -- methods' signatures
259 (MonoBinds flexi name pat) -- default methods
261 name name -- The names of the tycon and datacon for this class
262 -- These are filled in by the renamer
267 instance (NamedThing name, Outputable name, Outputable pat)
268 => Outputable (ClassDecl flexi name pat) where
270 ppr (ClassDecl context clas tyvars sigs methods pragmas _ _ src_loc)
271 | null sigs -- No "where" part
274 | otherwise -- Laid out
275 = sep [hsep [top_matter, ptext SLIT("where {")],
276 nest 4 (vcat [sep (map ppr_sig sigs),
280 top_matter = hsep [ptext SLIT("class"), pp_context_and_arrow context,
281 ppr clas, hsep (map (ppr) tyvars)]
282 ppr_sig sig = ppr sig <> semi
285 %************************************************************************
287 \subsection[InstDecl]{An instance declaration
289 %************************************************************************
292 data InstDecl flexi name pat
293 = InstDecl (HsType name) -- Context => Class Instance-type
294 -- Using a polytype means that the renamer conveniently
295 -- figures out the quantified type variables for us.
297 (MonoBinds flexi name pat)
299 [Sig name] -- User-supplied pragmatic info
301 (Maybe name) -- Name for the dictionary function
307 instance (NamedThing name, Outputable name, Outputable pat)
308 => Outputable (InstDecl flexi name pat) where
310 ppr (InstDecl inst_ty binds uprags dfun_name src_loc)
311 = getPprStyle $ \ sty ->
312 if ifaceStyle sty || (nullMonoBinds binds && null uprags) then
313 hsep [ptext SLIT("instance"), ppr inst_ty]
315 vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
321 %************************************************************************
323 \subsection[DefaultDecl]{A @default@ declaration}
325 %************************************************************************
327 There can only be one default declaration per module, but it is hard
328 for the parser to check that; we pass them all through in the abstract
329 syntax, and that restriction must be checked in the front end.
332 data DefaultDecl name
333 = DefaultDecl [HsType name]
336 instance (NamedThing name, Outputable name)
337 => Outputable (DefaultDecl name) where
339 ppr (DefaultDecl tys src_loc)
340 = ptext SLIT("default") <+> parens (interpp'SP tys)
343 %************************************************************************
345 \subsection{Signatures in interface files}
347 %************************************************************************
356 instance (NamedThing name, Outputable name) => Outputable (IfaceSig name) where
357 ppr (IfaceSig var ty _ _)
358 = hang (hsep [ppr var, ptext SLIT("::")])
363 | HsStrictness (HsStrictnessInfo name)
364 | HsUnfold Bool (UfExpr name) -- True <=> INLINE pragma
365 | HsUpdate UpdateInfo
366 | HsArgUsage ArgUsageInfo
367 | HsFBType FBTypeInfo
368 | HsSpecialise [HsTyVar name] [HsType name] (UfExpr name)
371 data HsStrictnessInfo name
372 = HsStrictnessInfo [Demand]
373 (Maybe (name, [name])) -- Worker, if any
374 -- and needed constructors