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@.
10 #include "HsVersions.h"
17 import HsBinds ( HsBinds, MonoBinds, Sig, nullMonoBinds )
18 import HsPragmas ( DataPragmas, ClassPragmas,
19 InstancePragmas, ClassOpPragmas
23 import SpecEnv ( SpecEnv )
24 import HsCore ( UfExpr )
25 import HsBasic ( Fixity )
26 import TyCon ( NewOrData(..) ) -- Just a boolean flag really
29 import Name --( getOccName, OccName )
30 import Outputable ( interppSP, interpp'SP,
31 Outputable(..){-instance * []-}
34 import SrcLoc ( SrcLoc )
35 import PprStyle ( PprStyle(..) )
40 %************************************************************************
42 \subsection[HsDecl]{Declarations}
44 %************************************************************************
47 data HsDecl tyvar uvar name pat
49 | ClD (ClassDecl tyvar uvar name pat)
50 | InstD (InstDecl tyvar uvar name pat)
51 | DefD (DefaultDecl name)
52 | ValD (HsBinds tyvar uvar name pat)
53 | SigD (IfaceSig name)
58 hsDeclName :: (NamedThing name, Outputable name, Outputable pat,
59 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
60 => HsDecl tyvar uvar name pat -> name
62 hsDeclName (TyD (TyData _ _ name _ _ _ _ _)) = name
63 hsDeclName (TyD (TySynonym name _ _ _)) = name
64 hsDeclName (ClD (ClassDecl _ name _ _ _ _ _)) = name
65 hsDeclName (SigD (IfaceSig name _ _ _)) = name
66 hsDeclName (InstD (InstDecl _ _ _ (Just name) _)) = name
67 -- Others don't make sense
69 hsDeclName x = pprPanic "HsDecls.hsDeclName" (ppr PprDebug x)
74 instance (NamedThing name, Outputable name, Outputable pat,
75 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
76 => Outputable (HsDecl tyvar uvar name pat) where
78 ppr sty (TyD td) = ppr sty td
79 ppr sty (ClD cd) = ppr sty cd
80 ppr sty (SigD sig) = ppr sty sig
81 ppr sty (ValD binds) = ppr sty binds
82 ppr sty (DefD def) = ppr sty def
83 ppr sty (InstD inst) = ppr sty inst
86 instance (Ord3 name, Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar,
87 NamedThing name, Outputable name, Outputable pat) =>
88 Ord3 (HsDecl tyvar uvar name pat) where
90 instance (Ord3 name) => Ord3 (HsDecl tyvar uvar name pat) where
92 d1 `cmp` d2 = hsDeclName d1 `cmp` hsDeclName d2
96 %************************************************************************
98 \subsection[FixityDecl]{A fixity declaration}
100 %************************************************************************
103 data FixityDecl name = FixityDecl name Fixity SrcLoc
105 instance Outputable name => Outputable (FixityDecl name) where
106 ppr sty (FixityDecl name fixity loc) = sep [ppr sty fixity, ppr sty name]
110 %************************************************************************
112 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
114 %************************************************************************
119 (Context name) -- context
120 name -- type constructor
121 [HsTyVar name] -- type variables
122 [ConDecl name] -- data constructors (empty if abstract)
123 (Maybe [name]) -- derivings; Nothing => not specified
124 -- (i.e., derive default); Just [] => derive
125 -- *nothing*; Just <list> => as you would
130 | TySynonym name -- type constructor
131 [HsTyVar name] -- type variables
132 (HsType name) -- synonym expansion
138 instance (NamedThing name, Outputable name)
139 => Outputable (TyDecl name) where
141 ppr sty (TySynonym tycon tyvars mono_ty src_loc)
142 = hang (pp_decl_head sty SLIT("type") empty tycon tyvars)
145 ppr sty (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
147 (pp_decl_head sty keyword (pp_context_and_arrow sty context) tycon tyvars)
148 (pp_condecls sty condecls)
151 keyword = case new_or_data of
152 NewType -> SLIT("newtype")
153 DataType -> SLIT("data")
155 pp_decl_head sty str pp_context tycon tyvars
156 = hsep [ptext str, pp_context, ppr sty tycon,
157 interppSP sty tyvars, ptext SLIT("=")]
159 pp_condecls sty [] = empty -- Curious!
160 pp_condecls sty (c:cs)
161 = sep (ppr sty c : map (\ c -> (<>) (ptext SLIT("| ")) (ppr sty c)) cs)
163 pp_tydecl sty pp_head pp_decl_rhs derivings
164 = hang pp_head 4 (sep [
166 case (derivings, sty) of
168 (_,PprInterface) -> empty -- No derivings in interfaces
169 (Just ds,_) -> hsep [ptext SLIT("deriving"), parens (interpp'SP sty ds)]
172 pp_context_and_arrow :: Outputable name => PprStyle -> Context name -> Doc
173 pp_context_and_arrow sty [] = empty
174 pp_context_and_arrow sty theta = hsep [pprContext sty theta, ptext SLIT("=>")]
177 A type for recording what types a datatype should be specialised to.
178 It's called a ``Sig'' because it's sort of like a ``type signature''
179 for an datatype declaration.
182 data SpecDataSig name
183 = SpecDataSig name -- tycon to specialise
187 instance (NamedThing name, Outputable name)
188 => Outputable (SpecDataSig name) where
190 ppr sty (SpecDataSig tycon ty _)
191 = hsep [text "{-# SPECIALIZE data", ppr sty ty, text "#-}"]
194 %************************************************************************
196 \subsection[ConDecl]{A data-constructor declaration}
198 %************************************************************************
202 = ConDecl name -- Constructor name
203 (Context name) -- Existential context for this constructor
208 = VanillaCon -- prefix-style con decl
211 | InfixCon -- infix-style con decl
215 | RecCon -- record-style con decl
216 [([name], BangType name)] -- list of "fields"
218 | NewCon -- newtype con decl
222 = Banged (HsType name) -- HsType: to allow Haskell extensions
223 | Unbanged (HsType name) -- (MonoType only needed for straight Haskell)
227 instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where
228 ppr sty (ConDecl con cxt con_details loc)
229 = pp_context_and_arrow sty cxt <+> ppr_con_details sty con con_details
231 ppr_con_details sty con (InfixCon ty1 ty2)
232 = hsep [ppr_bang sty ty1, ppr sty con, ppr_bang sty ty2]
234 ppr_con_details sty con (VanillaCon tys)
235 = ppr sty con <+> hsep (map (ppr_bang sty) tys)
237 ppr_con_details sty con (NewCon ty)
238 = ppr sty con <+> pprParendHsType sty ty
240 ppr_con_details sty con (RecCon fields)
241 = ppr sty con <+> braces (hsep (punctuate comma (map ppr_field fields)))
243 ppr_field (ns, ty) = hsep (map (ppr sty) ns) <+>
247 ppr_bang sty (Banged ty) = ptext SLIT("!") <> pprParendHsType sty ty
248 ppr_bang sty (Unbanged ty) = pprParendHsType sty ty
251 %************************************************************************
253 \subsection[ClassDecl]{A class declaration}
255 %************************************************************************
258 data ClassDecl tyvar uvar name pat
259 = ClassDecl (Context name) -- context...
260 name -- name of the class
261 (HsTyVar name) -- the class type variable
262 [Sig name] -- methods' signatures
263 (MonoBinds tyvar uvar name pat) -- default methods
269 instance (NamedThing name, Outputable name, Outputable pat,
270 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
271 => Outputable (ClassDecl tyvar uvar name pat) where
273 ppr sty (ClassDecl context clas tyvar sigs methods pragmas src_loc)
274 | null sigs -- No "where" part
277 | otherwise -- Laid out
278 = sep [hsep [top_matter, ptext SLIT("where {")],
279 nest 4 (vcat [sep (map ppr_sig sigs),
283 top_matter = hsep [ptext SLIT("class"), pp_context_and_arrow sty context,
284 ppr sty clas, ppr sty tyvar]
285 ppr_sig sig = ppr sty sig <> semi
288 %************************************************************************
290 \subsection[InstDecl]{An instance declaration (also, @SpecInstSig@)}
292 %************************************************************************
295 data InstDecl tyvar uvar name pat
296 = InstDecl (HsType name) -- Context => Class Instance-type
297 -- Using a polytype means that the renamer conveniently
298 -- figures out the quantified type variables for us.
300 (MonoBinds tyvar uvar name pat)
302 [Sig name] -- User-supplied pragmatic info
304 (Maybe name) -- Name for the dictionary function
310 instance (NamedThing name, Outputable name, Outputable pat,
311 Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
312 => Outputable (InstDecl tyvar uvar name pat) where
314 ppr sty (InstDecl inst_ty binds uprags dfun_name src_loc)
315 | case sty of { PprInterface -> True; other -> False} ||
316 nullMonoBinds binds && null uprags
317 = hsep [ptext SLIT("instance"), ppr sty inst_ty]
320 = vcat [hsep [ptext SLIT("instance"), ppr sty inst_ty, ptext SLIT("where")],
321 nest 4 (ppr sty uprags),
322 nest 4 (ppr sty binds) ]
325 A type for recording what instances the user wants to specialise;
326 called a ``Sig'' because it's sort of like a ``type signature'' for an
329 data SpecInstSig name
330 = SpecInstSig name -- class
331 (HsType name) -- type to specialise to
334 instance (NamedThing name, Outputable name)
335 => Outputable (SpecInstSig name) where
337 ppr sty (SpecInstSig clas ty _)
338 = hsep [text "{-# SPECIALIZE instance", ppr sty clas, ppr sty ty, text "#-}"]
341 %************************************************************************
343 \subsection[DefaultDecl]{A @default@ declaration}
345 %************************************************************************
347 There can only be one default declaration per module, but it is hard
348 for the parser to check that; we pass them all through in the abstract
349 syntax, and that restriction must be checked in the front end.
352 data DefaultDecl name
353 = DefaultDecl [HsType name]
356 instance (NamedThing name, Outputable name)
357 => Outputable (DefaultDecl name) where
359 ppr sty (DefaultDecl tys src_loc)
360 = (<>) (ptext SLIT("default ")) (parens (interpp'SP sty tys))
363 %************************************************************************
365 \subsection{Signatures in interface files}
367 %************************************************************************
376 instance (NamedThing name, Outputable name) => Outputable (IfaceSig name) where
377 ppr sty (IfaceSig var ty _ _)
378 = hang (hsep [ppr sty var, ptext SLIT("::")])
383 | HsStrictness (StrictnessInfo name)
384 | HsUnfold (UfExpr name)
385 | HsUpdate UpdateInfo
386 | HsDeforest DeforestInfo
387 | HsArgUsage ArgUsageInfo
388 | HsFBType FBTypeInfo
389 -- ToDo: specialisations