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(..), RuleDecl(..), RuleBndr(..),
12 DefaultDecl(..), ForeignDecl(..), ForKind(..),
13 ExtName(..), isDynamic,
14 ConDecl(..), ConDetails(..), BangType(..),
15 IfaceSig(..), SpecDataSig(..),
16 hsDeclName, tyClDeclName, isClassDecl, isSynDecl, isDataDecl, countTyClDecls
19 #include "HsVersions.h"
22 import HsBinds ( HsBinds, MonoBinds, Sig, FixitySig(..), nullMonoBinds )
23 import HsExpr ( HsExpr )
24 import HsPragmas ( DataPragmas, ClassPragmas )
26 import HsCore ( UfExpr, UfBinder, IfaceSig(..), UfRuleBody )
27 import BasicTypes ( Fixity, NewOrData(..) )
28 import CallConv ( CallConv, pprCallConv )
33 import {-# SOURCE #-} FunDeps ( pprFundeps )
35 import SrcLoc ( SrcLoc )
40 %************************************************************************
42 \subsection[HsDecl]{Declarations}
44 %************************************************************************
48 = TyClD (TyClDecl name pat)
49 | InstD (InstDecl name pat)
50 | DefD (DefaultDecl name)
51 | ValD (HsBinds name pat)
52 | ForD (ForeignDecl name)
53 | SigD (IfaceSig name)
54 | FixD (FixitySig name)
55 | RuleD (RuleDecl name pat)
57 -- NB: all top-level fixity decls are contained EITHER
59 -- OR in the ClassDecls in TyClDs
62 -- a) data constructors
63 -- b) class methods (but they can be also done in the
64 -- signatures of class decls)
65 -- c) imported functions (that have an IfacSig)
68 -- The latter is for class methods only
73 hsDeclName :: (Outputable name, Outputable pat)
74 => HsDecl name pat -> name
76 hsDeclName (TyClD decl) = tyClDeclName decl
77 hsDeclName (SigD (IfaceSig name _ _ _)) = name
78 hsDeclName (InstD (InstDecl _ _ _ name _)) = name
79 hsDeclName (ForD (ForeignDecl name _ _ _ _ _)) = name
80 hsDeclName (FixD (FixitySig name _ _)) = name
81 -- Others don't make sense
83 hsDeclName x = pprPanic "HsDecls.hsDeclName" (ppr x)
86 tyClDeclName :: TyClDecl name pat -> name
87 tyClDeclName (TyData _ _ name _ _ _ _ _) = name
88 tyClDeclName (TySynonym name _ _ _) = name
89 tyClDeclName (ClassDecl _ name _ _ _ _ _ _ _ _ _) = name
93 instance (Outputable name, Outputable pat)
94 => Outputable (HsDecl name pat) where
96 ppr (TyClD dcl) = ppr dcl
97 ppr (SigD sig) = ppr sig
98 ppr (ValD binds) = ppr binds
99 ppr (DefD def) = ppr def
100 ppr (InstD inst) = ppr inst
101 ppr (ForD fd) = ppr fd
102 ppr (FixD fd) = ppr fd
103 ppr (RuleD rd) = ppr rd
107 %************************************************************************
109 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
111 %************************************************************************
114 data TyClDecl name pat
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
132 | ClassDecl (Context name) -- context...
133 name -- name of the class
134 [HsTyVar name] -- the class type variables
135 [([name], [name])] -- functional dependencies
136 [Sig name] -- methods' signatures
137 (MonoBinds name pat) -- default methods
139 name name [name] -- The names of the tycon, datacon, and superclass selectors
140 -- for this class. These are filled in as the ClassDecl is made.
145 countTyClDecls :: [TyClDecl name pat] -> (Int, Int, Int, Int)
146 -- class, data, newtype, synonym decls
148 = (length [() | ClassDecl _ _ _ _ _ _ _ _ _ _ _ <- decls],
149 length [() | TyData DataType _ _ _ _ _ _ _ <- decls],
150 length [() | TyData NewType _ _ _ _ _ _ _ <- decls],
151 length [() | TySynonym _ _ _ _ <- decls])
153 isDataDecl, isSynDecl, isClassDecl :: TyClDecl name pat -> Bool
155 isSynDecl (TySynonym _ _ _ _) = True
156 isSynDecl other = False
158 isDataDecl (TyData _ _ _ _ _ _ _ _) = True
159 isDataDecl other = False
161 isClassDecl (ClassDecl _ _ _ _ _ _ _ _ _ _ _) = True
162 isClassDecl other = False
166 instance (Outputable name, Outputable pat)
167 => Outputable (TyClDecl name pat) where
169 ppr (TySynonym tycon tyvars mono_ty src_loc)
170 = hang (pp_decl_head SLIT("type") empty tycon tyvars)
173 ppr (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
175 (pp_decl_head keyword (pprContext context) tycon tyvars)
176 (pp_condecls condecls)
179 keyword = case new_or_data of
180 NewType -> SLIT("newtype")
181 DataType -> SLIT("data")
183 ppr (ClassDecl context clas tyvars fds sigs methods pragmas _ _ _ src_loc)
184 | null sigs -- No "where" part
187 | otherwise -- Laid out
188 = sep [hsep [top_matter, ptext SLIT("where {")],
189 nest 4 (vcat [sep (map ppr_sig sigs),
193 top_matter = hsep [ptext SLIT("class"), pprContext context,
194 ppr clas, hsep (map (ppr) tyvars), pprFundeps fds]
195 ppr_sig sig = ppr sig <> semi
198 pp_decl_head str pp_context tycon tyvars
199 = hsep [ptext str, pp_context, ppr tycon,
200 interppSP tyvars, ptext SLIT("=")]
202 pp_condecls [] = empty -- Curious!
203 pp_condecls (c:cs) = sep (ppr c : map (\ c -> ptext SLIT("|") <+> ppr c) cs)
205 pp_tydecl pp_head pp_decl_rhs derivings
206 = hang pp_head 4 (sep [
210 Just ds -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
214 A type for recording what types a datatype should be specialised to.
215 It's called a ``Sig'' because it's sort of like a ``type signature''
216 for an datatype declaration.
219 data SpecDataSig name
220 = SpecDataSig name -- tycon to specialise
224 instance (Outputable name)
225 => Outputable (SpecDataSig name) where
227 ppr (SpecDataSig tycon ty _)
228 = hsep [text "{-# SPECIALIZE data", ppr ty, text "#-}"]
231 %************************************************************************
233 \subsection[ConDecl]{A data-constructor declaration}
235 %************************************************************************
239 = ConDecl name -- Constructor name
241 [HsTyVar name] -- Existentially quantified type variables
242 (Context name) -- ...and context
243 -- If both are empty then there are no existentials
249 = VanillaCon -- prefix-style con decl
252 | InfixCon -- infix-style con decl
256 | RecCon -- record-style con decl
257 [([name], BangType name)] -- list of "fields"
259 | NewCon -- newtype con decl, possibly with a labelled field.
261 (Maybe name) -- Just x => labelled field 'x'
264 = Banged (HsType name) -- HsType: to allow Haskell extensions
265 | Unbanged (HsType name) -- (MonoType only needed for straight Haskell)
266 | Unpacked (HsType name) -- Field is strict and to be unpacked if poss.
270 instance (Outputable name) => Outputable (ConDecl name) where
271 ppr (ConDecl con tvs cxt con_details loc)
272 = sep [pprForAll tvs, pprContext cxt, ppr_con_details con con_details]
274 ppr_con_details con (InfixCon ty1 ty2)
275 = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
277 ppr_con_details con (VanillaCon tys)
278 = ppr con <+> hsep (map (ppr_bang) tys)
280 ppr_con_details con (NewCon ty Nothing)
281 = ppr con <+> pprParendHsType ty
283 ppr_con_details con (NewCon ty (Just x))
284 = ppr con <+> braces pp_field
286 pp_field = ppr x <+> dcolon <+> pprParendHsType ty
288 ppr_con_details con (RecCon fields)
289 = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
291 ppr_field (ns, ty) = hsep (map (ppr) ns) <+>
295 ppr_bang (Banged ty) = ptext SLIT("!") <> pprParendHsType ty
296 ppr_bang (Unbanged ty) = pprParendHsType ty
297 ppr_bang (Unpacked ty) = ptext SLIT("! !") <> pprParendHsType ty
301 %************************************************************************
303 \subsection[InstDecl]{An instance declaration
305 %************************************************************************
308 data InstDecl name pat
309 = InstDecl (HsType name) -- Context => Class Instance-type
310 -- Using a polytype means that the renamer conveniently
311 -- figures out the quantified type variables for us.
315 [Sig name] -- User-supplied pragmatic info
317 name -- Name for the dictionary function
323 instance (Outputable name, Outputable pat)
324 => Outputable (InstDecl name pat) where
326 ppr (InstDecl inst_ty binds uprags dfun_name src_loc)
327 = getPprStyle $ \ sty ->
328 if ifaceStyle sty || (nullMonoBinds binds && null uprags) then
329 hsep [ptext SLIT("instance"), ppr inst_ty]
331 vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
337 %************************************************************************
339 \subsection[DefaultDecl]{A @default@ declaration}
341 %************************************************************************
343 There can only be one default declaration per module, but it is hard
344 for the parser to check that; we pass them all through in the abstract
345 syntax, and that restriction must be checked in the front end.
348 data DefaultDecl name
349 = DefaultDecl [HsType name]
352 instance (Outputable name)
353 => Outputable (DefaultDecl name) where
355 ppr (DefaultDecl tys src_loc)
356 = ptext SLIT("default") <+> parens (interpp'SP tys)
359 %************************************************************************
361 \subsection{Foreign function interface declaration}
363 %************************************************************************
366 data ForeignDecl name =
375 instance (Outputable name)
376 => Outputable (ForeignDecl name) where
378 ppr (ForeignDecl nm imp_exp ty ext_name cconv src_loc)
379 = ptext SLIT("foreign") <+> ppr_imp_exp <+> pprCallConv cconv <+>
380 ppr ext_name <+> ppr_unsafe <+> ppr nm <+> dcolon <+> ppr ty
382 (ppr_imp_exp, ppr_unsafe) =
384 FoLabel -> (ptext SLIT("label"), empty)
385 FoExport -> (ptext SLIT("export"), empty)
387 | us -> (ptext SLIT("import"), ptext SLIT("unsafe"))
388 | otherwise -> (ptext SLIT("import"), empty)
393 | FoImport Bool -- True => unsafe call.
397 | ExtName FAST_STRING (Maybe FAST_STRING)
399 isDynamic :: ExtName -> Bool
400 isDynamic Dynamic = True
404 instance Outputable ExtName where
405 ppr Dynamic = ptext SLIT("dynamic")
406 ppr (ExtName nm mb_mod) =
407 case mb_mod of { Nothing -> empty; Just m -> doubleQuotes (ptext m) } <+>
408 doubleQuotes (ptext nm)
412 %************************************************************************
414 \subsection{Transformation rules}
416 %************************************************************************
419 data RuleDecl name pat
421 FAST_STRING -- Rule name
422 [name] -- Forall'd tyvars, filled in by the renamer with
423 -- tyvars mentioned in sigs; then filled out by typechecker
424 [RuleBndr name] -- Forall'd term vars
425 (HsExpr name pat) -- LHS
426 (HsExpr name pat) -- RHS
429 | IfaceRuleDecl -- One that's come in from an interface file
436 | RuleBndrSig name (HsType name)
438 instance (Outputable name, Outputable pat)
439 => Outputable (RuleDecl name pat) where
440 ppr (RuleDecl name tvs ns lhs rhs loc)
441 = text "RULE" <+> doubleQuotes (ptext name) <> colon <+>
442 sep [pp_forall, ppr lhs, equals <+> ppr rhs]
444 pp_forall | null tvs && null ns = empty
445 | otherwise = text "forall" <+>
446 fsep (map ppr tvs ++ map ppr ns)
448 ppr (IfaceRuleDecl var body loc) = text "An imported rule..."
450 instance Outputable name => Outputable (RuleBndr name) where
451 ppr (RuleBndr name) = ppr name
452 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty