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(..), isDynamicExtName, extNameStatic,
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 )
34 import CStrings ( CLabelString, pprCLabelString )
36 import SrcLoc ( SrcLoc )
41 %************************************************************************
43 \subsection[HsDecl]{Declarations}
45 %************************************************************************
49 = TyClD (TyClDecl name pat)
50 | InstD (InstDecl name pat)
51 | DefD (DefaultDecl name)
52 | ValD (HsBinds name pat)
53 | ForD (ForeignDecl name)
54 | SigD (IfaceSig name)
55 | FixD (FixitySig name)
56 | RuleD (RuleDecl name pat)
58 -- NB: all top-level fixity decls are contained EITHER
60 -- OR in the ClassDecls in TyClDs
63 -- a) data constructors
64 -- b) class methods (but they can be also done in the
65 -- signatures of class decls)
66 -- c) imported functions (that have an IfacSig)
69 -- The latter is for class methods only
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 _ _ _ 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
104 ppr (RuleD rd) = ppr rd
108 %************************************************************************
110 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
112 %************************************************************************
115 data TyClDecl name pat
117 (HsContext name) -- context
118 name -- type constructor
119 [HsTyVar name] -- type variables
120 [ConDecl name] -- data constructors (empty if abstract)
121 (Maybe [name]) -- derivings; Nothing => not specified
122 -- (i.e., derive default); Just [] => derive
123 -- *nothing*; Just <list> => as you would
128 | TySynonym name -- type constructor
129 [HsTyVar name] -- type variables
130 (HsType name) -- synonym expansion
133 | ClassDecl (HsContext name) -- context...
134 name -- name of the class
135 [HsTyVar name] -- the class type variables
136 [([name], [name])] -- functional dependencies
137 [Sig name] -- methods' signatures
138 (MonoBinds name pat) -- default methods
140 name name name [name] -- The names of the tycon, datacon wrapper, datacon worker,
141 -- and superclass selectors for this class.
142 -- These are filled in as the ClassDecl is made.
147 countTyClDecls :: [TyClDecl name pat] -> (Int, Int, Int, Int)
148 -- class, data, newtype, synonym decls
150 = (length [() | ClassDecl _ _ _ _ _ _ _ _ _ _ _ _ <- decls],
151 length [() | TyData DataType _ _ _ _ _ _ _ <- decls],
152 length [() | TyData NewType _ _ _ _ _ _ _ <- decls],
153 length [() | TySynonym _ _ _ _ <- decls])
155 isDataDecl, isSynDecl, isClassDecl :: TyClDecl name pat -> Bool
157 isSynDecl (TySynonym _ _ _ _) = True
158 isSynDecl other = False
160 isDataDecl (TyData _ _ _ _ _ _ _ _) = True
161 isDataDecl other = False
163 isClassDecl (ClassDecl _ _ _ _ _ _ _ _ _ _ _ _) = True
164 isClassDecl other = False
168 instance (Outputable name, Outputable pat)
169 => Outputable (TyClDecl name pat) where
171 ppr (TySynonym tycon tyvars mono_ty src_loc)
172 = hang (pp_decl_head SLIT("type") empty tycon tyvars)
175 ppr (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
177 (pp_decl_head keyword (pprHsContext context) tycon tyvars)
178 (pp_condecls condecls)
181 keyword = case new_or_data of
182 NewType -> SLIT("newtype")
183 DataType -> SLIT("data")
185 ppr (ClassDecl context clas tyvars fds sigs methods pragmas _ _ _ _ src_loc)
186 | null sigs -- No "where" part
189 | otherwise -- Laid out
190 = sep [hsep [top_matter, ptext SLIT("where {")],
191 nest 4 (vcat [sep (map ppr_sig sigs),
195 top_matter = hsep [ptext SLIT("class"), pprHsContext context,
196 ppr clas, hsep (map (ppr) tyvars), pprFundeps fds]
197 ppr_sig sig = ppr sig <> semi
200 pp_decl_head str pp_context tycon tyvars
201 = hsep [ptext str, pp_context, ppr tycon,
202 interppSP tyvars, ptext SLIT("=")]
204 pp_condecls [] = empty -- Curious!
205 pp_condecls (c:cs) = sep (ppr c : map (\ c -> ptext SLIT("|") <+> ppr c) cs)
207 pp_tydecl pp_head pp_decl_rhs derivings
208 = hang pp_head 4 (sep [
212 Just ds -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
216 A type for recording what types a datatype should be specialised to.
217 It's called a ``Sig'' because it's sort of like a ``type signature''
218 for an datatype declaration.
221 data SpecDataSig name
222 = SpecDataSig name -- tycon to specialise
226 instance (Outputable name)
227 => Outputable (SpecDataSig name) where
229 ppr (SpecDataSig tycon ty _)
230 = hsep [text "{-# SPECIALIZE data", ppr ty, text "#-}"]
233 %************************************************************************
235 \subsection[ConDecl]{A data-constructor declaration}
237 %************************************************************************
241 = ConDecl name -- Constructor name; this is used for the
242 -- DataCon itself, and for the user-callable wrapper Id
244 name -- Name of the constructor's 'worker Id'
245 -- Filled in as the ConDecl is built
247 [HsTyVar name] -- Existentially quantified type variables
248 (HsContext name) -- ...and context
249 -- If both are empty then there are no existentials
255 = VanillaCon -- prefix-style con decl
258 | InfixCon -- infix-style con decl
262 | RecCon -- record-style con decl
263 [([name], BangType name)] -- list of "fields"
265 | NewCon -- newtype con decl, possibly with a labelled field.
267 (Maybe name) -- Just x => labelled field 'x'
270 = Banged (HsType name) -- HsType: to allow Haskell extensions
271 | Unbanged (HsType name) -- (MonoType only needed for straight Haskell)
272 | Unpacked (HsType name) -- Field is strict and to be unpacked if poss.
276 instance (Outputable name) => Outputable (ConDecl name) where
277 ppr (ConDecl con _ tvs cxt con_details loc)
278 = sep [pprForAll tvs, pprHsContext cxt, ppr_con_details con con_details]
280 ppr_con_details con (InfixCon ty1 ty2)
281 = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
283 ppr_con_details con (VanillaCon tys)
284 = ppr con <+> hsep (map (ppr_bang) tys)
286 ppr_con_details con (NewCon ty Nothing)
287 = ppr con <+> pprParendHsType ty
289 ppr_con_details con (NewCon ty (Just x))
290 = ppr con <+> braces pp_field
292 pp_field = ppr x <+> dcolon <+> pprParendHsType ty
294 ppr_con_details con (RecCon fields)
295 = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
297 ppr_field (ns, ty) = hsep (map (ppr) ns) <+>
301 ppr_bang (Banged ty) = ptext SLIT("!") <> pprParendHsType ty
302 ppr_bang (Unbanged ty) = pprParendHsType ty
303 ppr_bang (Unpacked ty) = ptext SLIT("! !") <> pprParendHsType ty
307 %************************************************************************
309 \subsection[InstDecl]{An instance declaration
311 %************************************************************************
314 data InstDecl name pat
315 = InstDecl (HsType name) -- Context => Class Instance-type
316 -- Using a polytype means that the renamer conveniently
317 -- figures out the quantified type variables for us.
321 [Sig name] -- User-supplied pragmatic info
323 name -- Name for the dictionary function
329 instance (Outputable name, Outputable pat)
330 => Outputable (InstDecl name pat) where
332 ppr (InstDecl inst_ty binds uprags dfun_name src_loc)
333 = getPprStyle $ \ sty ->
334 if ifaceStyle sty || (nullMonoBinds binds && null uprags) then
335 hsep [ptext SLIT("instance"), ppr inst_ty]
337 vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
343 %************************************************************************
345 \subsection[DefaultDecl]{A @default@ declaration}
347 %************************************************************************
349 There can only be one default declaration per module, but it is hard
350 for the parser to check that; we pass them all through in the abstract
351 syntax, and that restriction must be checked in the front end.
354 data DefaultDecl name
355 = DefaultDecl [HsType name]
358 instance (Outputable name)
359 => Outputable (DefaultDecl name) where
361 ppr (DefaultDecl tys src_loc)
362 = ptext SLIT("default") <+> parens (interpp'SP tys)
365 %************************************************************************
367 \subsection{Foreign function interface declaration}
369 %************************************************************************
372 data ForeignDecl name =
381 instance (Outputable name)
382 => Outputable (ForeignDecl name) where
384 ppr (ForeignDecl nm imp_exp ty ext_name cconv src_loc)
385 = ptext SLIT("foreign") <+> ppr_imp_exp <+> pprCallConv cconv <+>
386 ppr ext_name <+> ppr_unsafe <+> ppr nm <+> dcolon <+> ppr ty
388 (ppr_imp_exp, ppr_unsafe) =
390 FoLabel -> (ptext SLIT("label"), empty)
391 FoExport -> (ptext SLIT("export"), empty)
393 | us -> (ptext SLIT("import"), ptext SLIT("unsafe"))
394 | otherwise -> (ptext SLIT("import"), empty)
399 | FoImport Bool -- True => unsafe call.
403 | ExtName CLabelString -- The external name of the foreign thing,
404 (Maybe CLabelString) -- and optionally its DLL or module name
405 -- Both of these are completely unencoded;
406 -- we just print them as they are
408 isDynamicExtName :: ExtName -> Bool
409 isDynamicExtName Dynamic = True
410 isDynamicExtName _ = False
412 extNameStatic :: ExtName -> CLabelString
413 extNameStatic (ExtName f _) = f
414 extNameStatic Dynamic = panic "staticExtName: Dynamic - shouldn't ever happen."
416 instance Outputable ExtName where
417 ppr Dynamic = ptext SLIT("dynamic")
418 ppr (ExtName nm mb_mod) =
419 case mb_mod of { Nothing -> empty; Just m -> doubleQuotes (ptext m) } <+>
420 doubleQuotes (pprCLabelString nm)
423 %************************************************************************
425 \subsection{Transformation rules}
427 %************************************************************************
430 data RuleDecl name pat
432 FAST_STRING -- Rule name
433 [name] -- Forall'd tyvars, filled in by the renamer with
434 -- tyvars mentioned in sigs; then filled out by typechecker
435 [RuleBndr name] -- Forall'd term vars
436 (HsExpr name pat) -- LHS
437 (HsExpr name pat) -- RHS
440 | IfaceRuleDecl -- One that's come in from an interface file
447 | RuleBndrSig name (HsType name)
449 instance (Outputable name, Outputable pat)
450 => Outputable (RuleDecl name pat) where
451 ppr (RuleDecl name tvs ns lhs rhs loc)
452 = sep [text "{-# RULES" <+> doubleQuotes (ptext name),
453 pp_forall, ppr lhs, equals <+> ppr rhs,
456 pp_forall | null tvs && null ns = empty
457 | otherwise = text "forall" <+>
458 fsep (map ppr tvs ++ map ppr ns)
460 ppr (IfaceRuleDecl var body loc) = text "An imported rule..."
462 instance Outputable name => Outputable (RuleBndr name) where
463 ppr (RuleBndr name) = ppr name
464 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty