2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
9 {-# OPTIONS -fno-warn-incomplete-patterns #-}
10 -- The above warning supression flag is a temporary kludge.
11 -- While working on this module you are encouraged to remove it and fix
12 -- any warnings in the module. See
13 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
16 -- | Abstract syntax of global declarations.
18 -- Definitions for: @TyDecl@ and @ConDecl@, @ClassDecl@,
19 -- @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
21 -- * Toplevel declarations
23 -- ** Class or type declarations
24 TyClDecl(..), LTyClDecl,
25 isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl,
26 isFamInstDecl, tcdName, tyClDeclNames, tyClDeclTyVars,
28 -- ** Instance declarations
29 InstDecl(..), LInstDecl, NewOrData(..), FamilyFlavour(..),
31 -- ** Standalone deriving declarations
32 DerivDecl(..), LDerivDecl,
33 -- ** @RULE@ declarations
34 RuleDecl(..), LRuleDecl, RuleBndr(..),
35 collectRuleBndrSigTys,
36 -- ** @default@ declarations
37 DefaultDecl(..), LDefaultDecl,
38 -- ** Top-level template haskell splice
40 -- ** Foreign function interface declarations
41 ForeignDecl(..), LForeignDecl, ForeignImport(..), ForeignExport(..),
42 CImportSpec(..), FoType(..),
43 -- ** Data-constructor declarations
44 ConDecl(..), LConDecl, ResType(..), ConDeclField(..),
45 HsConDeclDetails, hsConDeclArgTys,
46 -- ** Document comments
47 DocDecl(..), LDocDecl, docDeclDoc,
49 WarnDecl(..), LWarnDecl,
52 HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups,
56 import {-# SOURCE #-} HsExpr( HsExpr, pprExpr )
57 -- Because Expr imports Decls via HsBracket
64 import {- Kind parts of -} Type
75 import Data.Maybe ( isJust )
78 %************************************************************************
80 \subsection[HsDecl]{Declarations}
82 %************************************************************************
85 type LHsDecl id = Located (HsDecl id)
87 -- | A Haskell Declaration
89 = TyClD (TyClDecl id) -- ^ A type or class declaration.
90 | InstD (InstDecl id) -- ^ An instance declaration.
91 | DerivD (DerivDecl id)
94 | DefD (DefaultDecl id)
95 | ForD (ForeignDecl id)
96 | WarningD (WarnDecl id)
98 | SpliceD (SpliceDecl id)
102 -- NB: all top-level fixity decls are contained EITHER
104 -- OR in the ClassDecls in TyClDs
107 -- a) data constructors
108 -- b) class methods (but they can be also done in the
109 -- signatures of class decls)
110 -- c) imported functions (that have an IfacSig)
111 -- d) top level decls
113 -- The latter is for class methods only
115 -- | A 'HsDecl' is categorised into a 'HsGroup' before being
116 -- fed to the renamer.
119 hs_valds :: HsValBinds id,
120 hs_tyclds :: [LTyClDecl id],
121 hs_instds :: [LInstDecl id],
122 hs_derivds :: [LDerivDecl id],
124 hs_fixds :: [LFixitySig id],
125 -- Snaffled out of both top-level fixity signatures,
126 -- and those in class declarations
128 hs_defds :: [LDefaultDecl id],
129 hs_fords :: [LForeignDecl id],
130 hs_warnds :: [LWarnDecl id],
131 hs_ruleds :: [LRuleDecl id],
133 hs_docs :: [LDocDecl id]
136 emptyGroup, emptyRdrGroup, emptyRnGroup :: HsGroup a
137 emptyRdrGroup = emptyGroup { hs_valds = emptyValBindsIn }
138 emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut }
140 emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [],
141 hs_fixds = [], hs_defds = [], hs_fords = [],
142 hs_warnds = [], hs_ruleds = [],
143 hs_valds = error "emptyGroup hs_valds: Can't happen",
146 appendGroups :: HsGroup a -> HsGroup a -> HsGroup a
149 hs_valds = val_groups1,
152 hs_derivds = derivds1,
160 hs_valds = val_groups2,
163 hs_derivds = derivds2,
172 hs_valds = val_groups1 `plusHsValBinds` val_groups2,
173 hs_tyclds = tyclds1 ++ tyclds2,
174 hs_instds = instds1 ++ instds2,
175 hs_derivds = derivds1 ++ derivds2,
176 hs_fixds = fixds1 ++ fixds2,
177 hs_defds = defds1 ++ defds2,
178 hs_fords = fords1 ++ fords2,
179 hs_warnds = warnds1 ++ warnds2,
180 hs_ruleds = rulds1 ++ rulds2,
181 hs_docs = docs1 ++ docs2 }
185 instance OutputableBndr name => Outputable (HsDecl name) where
186 ppr (TyClD dcl) = ppr dcl
187 ppr (ValD binds) = ppr binds
188 ppr (DefD def) = ppr def
189 ppr (InstD inst) = ppr inst
190 ppr (DerivD deriv) = ppr deriv
191 ppr (ForD fd) = ppr fd
192 ppr (SigD sd) = ppr sd
193 ppr (RuleD rd) = ppr rd
194 ppr (WarningD wd) = ppr wd
195 ppr (SpliceD dd) = ppr dd
196 ppr (DocD doc) = ppr doc
198 instance OutputableBndr name => Outputable (HsGroup name) where
199 ppr (HsGroup { hs_valds = val_decls,
200 hs_tyclds = tycl_decls,
201 hs_instds = inst_decls,
202 hs_derivds = deriv_decls,
203 hs_fixds = fix_decls,
204 hs_warnds = deprec_decls,
205 hs_fords = foreign_decls,
206 hs_defds = default_decls,
207 hs_ruleds = rule_decls })
208 = vcat [ppr_ds fix_decls, ppr_ds default_decls,
209 ppr_ds deprec_decls, ppr_ds rule_decls,
211 ppr_ds tycl_decls, ppr_ds inst_decls,
213 ppr_ds foreign_decls]
216 ppr_ds ds = text "" $$ vcat (map ppr ds)
218 data SpliceDecl id = SpliceDecl (Located (HsExpr id)) -- Top level splice
220 instance OutputableBndr name => Outputable (SpliceDecl name) where
221 ppr (SpliceDecl e) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
225 %************************************************************************
227 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
229 %************************************************************************
231 --------------------------------
233 --------------------------------
235 Here is the story about the implicit names that go with type, class,
236 and instance decls. It's a bit tricky, so pay attention!
238 "Implicit" (or "system") binders
239 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
240 Each data type decl defines
241 a worker name for each constructor
242 to-T and from-T convertors
243 Each class decl defines
244 a tycon for the class
245 a data constructor for that tycon
246 the worker for that constructor
247 a selector for each superclass
249 All have occurrence names that are derived uniquely from their parent
252 None of these get separate definitions in an interface file; they are
253 fully defined by the data or class decl. But they may *occur* in
254 interface files, of course. Any such occurrence must haul in the
255 relevant type or class decl.
258 - Ensure they "point to" the parent data/class decl
259 when loading that decl from an interface file
260 (See RnHiFiles.getSysBinders)
262 - When typechecking the decl, we build the implicit TyCons and Ids.
263 When doing so we look them up in the name cache (RnEnv.lookupSysName),
264 to ensure correct module and provenance is set
266 These are the two places that we have to conjure up the magic derived
267 names. (The actual magic is in OccName.mkWorkerOcc, etc.)
271 - Occurrence name is derived uniquely from the method name
274 - If there is a default method name at all, it's recorded in
275 the ClassOpSig (in HsBinds), in the DefMeth field.
276 (DefMeth is defined in Class.lhs)
278 Source-code class decls and interface-code class decls are treated subtly
279 differently, which has given me a great deal of confusion over the years.
280 Here's the deal. (We distinguish the two cases because source-code decls
281 have (Just binds) in the tcdMeths field, whereas interface decls have Nothing.
283 In *source-code* class declarations:
285 - When parsing, every ClassOpSig gets a DefMeth with a suitable RdrName
286 This is done by RdrHsSyn.mkClassOpSigDM
288 - The renamer renames it to a Name
290 - During typechecking, we generate a binding for each $dm for
291 which there's a programmer-supplied default method:
296 We generate a binding for $dmop1 but not for $dmop2.
297 The Class for Foo has a NoDefMeth for op2 and a DefMeth for op1.
298 The Name for $dmop2 is simply discarded.
300 In *interface-file* class declarations:
301 - When parsing, we see if there's an explicit programmer-supplied default method
302 because there's an '=' sign to indicate it:
304 op1 = :: <type> -- NB the '='
306 We use this info to generate a DefMeth with a suitable RdrName for op1,
307 and a NoDefMeth for op2
308 - The interface file has a separate definition for $dmop1, with unfolding etc.
309 - The renamer renames it to a Name.
310 - The renamer treats $dmop1 as a free variable of the declaration, so that
311 the binding for $dmop1 will be sucked in. (See RnHsSyn.tyClDeclFVs)
312 This doesn't happen for source code class decls, because they *bind* the default method.
316 Each instance declaration gives rise to one dictionary function binding.
318 The type checker makes up new source-code instance declarations
319 (e.g. from 'deriving' or generic default methods --- see
320 TcInstDcls.tcInstDecls1). So we can't generate the names for
321 dictionary functions in advance (we don't know how many we need).
323 On the other hand for interface-file instance declarations, the decl
324 specifies the name of the dictionary function, and it has a binding elsewhere
325 in the interface file:
326 instance {Eq Int} = dEqInt
327 dEqInt :: {Eq Int} <pragma info>
329 So again we treat source code and interface file code slightly differently.
332 - Source code instance decls have a Nothing in the (Maybe name) field
333 (see data InstDecl below)
335 - The typechecker makes up a Local name for the dict fun for any source-code
336 instance decl, whether it comes from a source-code instance decl, or whether
337 the instance decl is derived from some other construct (e.g. 'deriving').
339 - The occurrence name it chooses is derived from the instance decl (just for
340 documentation really) --- e.g. dNumInt. Two dict funs may share a common
341 occurrence name, but will have different uniques. E.g.
342 instance Foo [Int] where ...
343 instance Foo [Bool] where ...
344 These might both be dFooList
346 - The CoreTidy phase externalises the name, and ensures the occurrence name is
347 unique (this isn't special to dict funs). So we'd get dFooList and dFooList1.
349 - We can take this relaxed approach (changing the occurrence name later)
350 because dict fun Ids are not captured in a TyCon or Class (unlike default
351 methods, say). Instead, they are kept separately in the InstEnv. This
352 makes it easy to adjust them after compiling a module. (Once we've finished
353 compiling that module, they don't change any more.)
357 - The instance decl gives the dict fun name, so the InstDecl has a (Just name)
358 in the (Maybe name) field.
360 - RnHsSyn.instDeclFVs treats the dict fun name as free in the decl, so that we
361 suck in the dfun binding
365 -- Representation of indexed types
366 -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
367 -- Family kind signatures are represented by the variant `TyFamily'. It
368 -- covers "type family", "newtype family", and "data family" declarations,
369 -- distinguished by the value of the field `tcdFlavour'.
371 -- Indexed types are represented by 'TyData' and 'TySynonym' using the field
372 -- 'tcdTyPats::Maybe [LHsType name]', with the following meaning:
374 -- * If it is 'Nothing', we have a *vanilla* data type declaration or type
375 -- synonym declaration and 'tcdVars' contains the type parameters of the
378 -- * If it is 'Just pats', we have the definition of an indexed type. Then,
379 -- 'pats' are type patterns for the type-indexes of the type constructor
380 -- and 'tcdTyVars' are the variables in those patterns. Hence, the arity of
381 -- the indexed type (ie, the number of indexes) is 'length tcdTyPats' and
382 -- *not* 'length tcdVars'.
384 -- In both cases, 'tcdVars' collects all variables we need to quantify over.
386 type LTyClDecl name = Located (TyClDecl name)
388 -- | A type or class declaration.
391 tcdLName :: Located name,
392 tcdExtName :: Maybe FastString,
397 | -- | @type/data/newtype family T :: *->*@
398 TyFamily { tcdFlavour:: FamilyFlavour, -- type, new, or data
399 tcdLName :: Located name, -- type constructor
400 tcdTyVars :: [LHsTyVarBndr name], -- type variables
401 tcdKind :: Maybe Kind -- result kind
405 | -- | Declares a data type or newtype, giving its construcors
407 -- data/newtype T a = <constrs>
408 -- data/newtype instance T [a] = <constrs>
410 TyData { tcdND :: NewOrData,
411 tcdCtxt :: LHsContext name, -- ^ Context
412 tcdLName :: Located name, -- ^ Type constructor
414 tcdTyVars :: [LHsTyVarBndr name], -- ^ Type variables
416 tcdTyPats :: Maybe [LHsType name],
419 -- @Just [t1..tn]@ for @data instance T t1..tn = ...@
420 -- in this case @tcdTyVars = fv( tcdTyPats )@.
421 -- @Nothing@ for everything else.
423 tcdKindSig:: Maybe Kind,
424 -- ^ Optional kind signature.
426 -- @(Just k)@ for a GADT-style @data@, or @data
427 -- instance@ decl with explicit kind sig
429 tcdCons :: [LConDecl name],
430 -- ^ Data constructors
432 -- For @data T a = T1 | T2 a@
433 -- the 'LConDecl's all have 'ResTyH98'.
434 -- For @data T a where { T1 :: T a }@
435 -- the 'LConDecls' all have 'ResTyGADT'.
437 tcdDerivs :: Maybe [LHsType name]
438 -- ^ Derivings; @Nothing@ => not specified,
439 -- @Just []@ => derive exactly what is asked
441 -- These "types" must be of form
443 -- forall ab. C ty1 ty2
445 -- Typically the foralls and ty args are empty, but they
446 -- are non-empty for the newtype-deriving case
449 | TySynonym { tcdLName :: Located name, -- ^ type constructor
450 tcdTyVars :: [LHsTyVarBndr name], -- ^ type variables
451 tcdTyPats :: Maybe [LHsType name], -- ^ Type patterns
452 -- See comments for tcdTyPats in TyData
453 -- 'Nothing' => vanilla type synonym
455 tcdSynRhs :: LHsType name -- ^ synonym expansion
458 | ClassDecl { tcdCtxt :: LHsContext name, -- ^ Context...
459 tcdLName :: Located name, -- ^ Name of the class
460 tcdTyVars :: [LHsTyVarBndr name], -- ^ Class type variables
461 tcdFDs :: [Located (FunDep name)], -- ^ Functional deps
462 tcdSigs :: [LSig name], -- ^ Methods' signatures
463 tcdMeths :: LHsBinds name, -- ^ Default methods
464 tcdATs :: [LTyClDecl name], -- ^ Associated types; ie
465 -- only 'TyFamily' and
467 -- latter for defaults
468 tcdDocs :: [LDocDecl name] -- ^ Haddock docs
472 = NewType -- ^ @newtype Blah ...@
473 | DataType -- ^ @data Blah ...@
474 deriving( Eq ) -- Needed because Demand derives Eq
477 = TypeFamily -- ^ @type family ...@
478 | DataFamily -- ^ @data family ...@
484 -- | @True@ <=> argument is a @data@\/@newtype@ or @data@\/@newtype instance@
486 isDataDecl :: TyClDecl name -> Bool
487 isDataDecl (TyData {}) = True
488 isDataDecl _other = False
490 -- | type or type instance declaration
491 isTypeDecl :: TyClDecl name -> Bool
492 isTypeDecl (TySynonym {}) = True
493 isTypeDecl _other = False
495 -- | vanilla Haskell type synonym (ie, not a type instance)
496 isSynDecl :: TyClDecl name -> Bool
497 isSynDecl (TySynonym {tcdTyPats = Nothing}) = True
498 isSynDecl _other = False
501 isClassDecl :: TyClDecl name -> Bool
502 isClassDecl (ClassDecl {}) = True
503 isClassDecl _ = False
505 -- | type family declaration
506 isFamilyDecl :: TyClDecl name -> Bool
507 isFamilyDecl (TyFamily {}) = True
508 isFamilyDecl _other = False
510 -- | family instance (types, newtypes, and data types)
511 isFamInstDecl :: TyClDecl name -> Bool
514 || isDataDecl tydecl = isJust (tcdTyPats tydecl)
521 tcdName :: TyClDecl name -> name
522 tcdName decl = unLoc (tcdLName decl)
524 tyClDeclNames :: Eq name => TyClDecl name -> [Located name]
525 -- Returns all the *binding* names of the decl, along with their SrcLocs
526 -- The first one is guaranteed to be the name of the decl
527 -- For record fields, the first one counts as the SrcLoc
528 -- We use the equality to filter out duplicate field names
530 tyClDeclNames (TyFamily {tcdLName = name}) = [name]
531 tyClDeclNames (TySynonym {tcdLName = name}) = [name]
532 tyClDeclNames (ForeignType {tcdLName = name}) = [name]
534 tyClDeclNames (ClassDecl {tcdLName = cls_name, tcdSigs = sigs, tcdATs = ats})
536 concatMap (tyClDeclNames . unLoc) ats ++ [n | L _ (TypeSig n _) <- sigs]
538 tyClDeclNames (TyData {tcdLName = tc_name, tcdCons = cons})
539 = tc_name : conDeclsNames (map unLoc cons)
541 tyClDeclTyVars :: TyClDecl name -> [LHsTyVarBndr name]
542 tyClDeclTyVars (TyFamily {tcdTyVars = tvs}) = tvs
543 tyClDeclTyVars (TySynonym {tcdTyVars = tvs}) = tvs
544 tyClDeclTyVars (TyData {tcdTyVars = tvs}) = tvs
545 tyClDeclTyVars (ClassDecl {tcdTyVars = tvs}) = tvs
546 tyClDeclTyVars (ForeignType {}) = []
550 countTyClDecls :: [TyClDecl name] -> (Int, Int, Int, Int, Int, Int)
551 -- class, synonym decls, data, newtype, family decls, family instances
553 = (count isClassDecl decls,
554 count isSynDecl decls, -- excluding...
555 count isDataTy decls, -- ...family...
556 count isNewTy decls, -- ...instances
557 count isFamilyDecl decls,
558 count isFamInstDecl decls)
560 isDataTy TyData{tcdND = DataType, tcdTyPats = Nothing} = True
563 isNewTy TyData{tcdND = NewType, tcdTyPats = Nothing} = True
568 instance OutputableBndr name
569 => Outputable (TyClDecl name) where
571 ppr (ForeignType {tcdLName = ltycon})
572 = hsep [ptext (sLit "foreign import type dotnet"), ppr ltycon]
574 ppr (TyFamily {tcdFlavour = flavour, tcdLName = ltycon,
575 tcdTyVars = tyvars, tcdKind = mb_kind})
576 = pp_flavour <+> pp_decl_head [] ltycon tyvars Nothing <+> pp_kind
578 pp_flavour = case flavour of
579 TypeFamily -> ptext (sLit "type family")
580 DataFamily -> ptext (sLit "data family")
582 pp_kind = case mb_kind of
584 Just kind -> dcolon <+> pprKind kind
586 ppr (TySynonym {tcdLName = ltycon, tcdTyVars = tyvars, tcdTyPats = typats,
587 tcdSynRhs = mono_ty})
588 = hang (ptext (sLit "type") <+>
589 (if isJust typats then ptext (sLit "instance") else empty) <+>
590 pp_decl_head [] ltycon tyvars typats <+>
594 ppr (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = ltycon,
595 tcdTyVars = tyvars, tcdTyPats = typats, tcdKindSig = mb_sig,
596 tcdCons = condecls, tcdDerivs = derivings})
597 = pp_tydecl (null condecls && isJust mb_sig)
599 (if isJust typats then ptext (sLit "instance") else empty) <+>
600 pp_decl_head (unLoc context) ltycon tyvars typats <+>
602 (pp_condecls condecls)
605 ppr_sig Nothing = empty
606 ppr_sig (Just kind) = dcolon <+> pprKind kind
608 ppr (ClassDecl {tcdCtxt = context, tcdLName = lclas, tcdTyVars = tyvars,
610 tcdSigs = sigs, tcdMeths = methods, tcdATs = ats})
611 | null sigs && null ats -- No "where" part
614 | otherwise -- Laid out
615 = sep [hsep [top_matter, ptext (sLit "where {")],
616 nest 4 (sep [ sep (map ppr_semi ats)
617 , sep (map ppr_semi sigs)
618 , pprLHsBinds methods
621 top_matter = ptext (sLit "class")
622 <+> pp_decl_head (unLoc context) lclas tyvars Nothing
623 <+> pprFundeps (map unLoc fds)
624 ppr_semi decl = ppr decl <> semi
626 pp_decl_head :: OutputableBndr name
629 -> [LHsTyVarBndr name]
630 -> Maybe [LHsType name]
632 pp_decl_head context thing tyvars Nothing -- no explicit type patterns
633 = hsep [pprHsContext context, ppr thing, interppSP tyvars]
634 pp_decl_head context thing _ (Just typats) -- explicit type patterns
635 = hsep [ pprHsContext context, ppr thing
636 , hsep (map (pprParendHsType.unLoc) typats)]
638 pp_condecls :: OutputableBndr name => [LConDecl name] -> SDoc
639 pp_condecls cs@(L _ ConDecl{ con_res = ResTyGADT _ } : _) -- In GADT syntax
640 = hang (ptext (sLit "where")) 2 (vcat (map ppr cs))
641 pp_condecls cs -- In H98 syntax
642 = equals <+> sep (punctuate (ptext (sLit " |")) (map ppr cs))
644 pp_tydecl :: OutputableBndr name => Bool -> SDoc -> SDoc -> Maybe [LHsType name] -> SDoc
645 pp_tydecl True pp_head _ _
647 pp_tydecl False pp_head pp_decl_rhs derivings
648 = hang pp_head 4 (sep [
652 Just ds -> hsep [ptext (sLit "deriving"), parens (interpp'SP ds)]
655 instance Outputable NewOrData where
656 ppr NewType = ptext (sLit "newtype")
657 ppr DataType = ptext (sLit "data")
661 %************************************************************************
663 \subsection[ConDecl]{A data-constructor declaration}
665 %************************************************************************
668 type LConDecl name = Located (ConDecl name)
670 -- data T b = forall a. Eq a => MkT a b
671 -- MkT :: forall b a. Eq a => MkT a b
674 -- MkT1 :: Int -> T Int
676 -- data T = Int `MkT` Int
680 -- Int `MkT` Int :: T Int
684 { con_name :: Located name -- Constructor name; this is used for the
685 -- DataCon itself, and for the user-callable wrapper Id
687 , con_explicit :: HsExplicitForAll -- Is there an user-written forall? (cf. HStypes.HsForAllTy)
689 , con_qvars :: [LHsTyVarBndr name] -- ResTyH98: the constructor's existential type variables
690 -- ResTyGADT: all the constructor's quantified type variables
692 , con_cxt :: LHsContext name -- The context. This *does not* include the
693 -- "stupid theta" which lives only in the TyData decl
695 , con_details :: HsConDeclDetails name -- The main payload
697 , con_res :: ResType name -- Result type of the constructor
699 , con_doc :: Maybe (LHsDoc name) -- A possible Haddock comment
702 type HsConDeclDetails name = HsConDetails (LBangType name) [ConDeclField name]
704 hsConDeclArgTys :: HsConDeclDetails name -> [LBangType name]
705 hsConDeclArgTys (PrefixCon tys) = tys
706 hsConDeclArgTys (InfixCon ty1 ty2) = [ty1,ty2]
707 hsConDeclArgTys (RecCon flds) = map cd_fld_type flds
709 data ConDeclField name -- Record fields have Haddoc docs on them
710 = ConDeclField { cd_fld_name :: Located name,
711 cd_fld_type :: LBangType name,
712 cd_fld_doc :: Maybe (LHsDoc name) }
715 = ResTyH98 -- Constructor was declared using Haskell 98 syntax
716 | ResTyGADT (LHsType name) -- Constructor was declared using GADT-style syntax,
717 -- and here is its result type
721 conDeclsNames :: (Eq name) => [ConDecl name] -> [Located name]
722 -- See tyClDeclNames for what this does
723 -- The function is boringly complicated because of the records
724 -- And since we only have equality, we have to be a little careful
726 = snd (foldl do_one ([], []) cons)
728 do_one (flds_seen, acc) (ConDecl { con_name = lname, con_details = RecCon flds })
729 = (map unLoc new_flds ++ flds_seen, lname : new_flds ++ acc)
731 new_flds = filterOut (\f -> unLoc f `elem` flds_seen)
732 (map cd_fld_name flds)
734 do_one (flds_seen, acc) c
735 = (flds_seen, (con_name c):acc)
740 instance (OutputableBndr name) => Outputable (ConDecl name) where
743 pprConDecl :: OutputableBndr name => ConDecl name -> SDoc
744 pprConDecl (ConDecl con expl tvs cxt details ResTyH98 doc)
745 = sep [ppr_mbDoc doc, pprHsForAll expl tvs cxt, ppr_details con details]
747 ppr_details con (InfixCon t1 t2) = hsep [ppr t1, pprHsInfix con, ppr t2]
748 ppr_details con (PrefixCon tys) = hsep (pprHsVar con : map ppr tys)
749 ppr_details con (RecCon fields) = ppr con <+> ppr_fields fields
751 pprConDecl (ConDecl con expl tvs cxt (PrefixCon arg_tys) (ResTyGADT res_ty) _)
752 = ppr con <+> dcolon <+>
753 sep [pprHsForAll expl tvs cxt, ppr (foldr mk_fun_ty res_ty arg_tys)]
755 mk_fun_ty a b = noLoc (HsFunTy a b)
757 pprConDecl (ConDecl con expl tvs cxt (RecCon fields) (ResTyGADT res_ty) _)
758 = sep [pprHsForAll expl tvs cxt, ppr con <+> ppr_fields fields <+> dcolon <+> ppr res_ty]
760 pprConDecl (ConDecl con _expl _tvs _cxt (InfixCon _ _) (ResTyGADT _res_ty) _)
761 = pprPanic "pprConDecl" (ppr con)
762 -- In GADT syntax we don't allow infix constructors
765 ppr_fields :: OutputableBndr name => [ConDeclField name] -> SDoc
766 ppr_fields fields = braces (sep (punctuate comma (map ppr_fld fields)))
768 ppr_fld (ConDeclField { cd_fld_name = n, cd_fld_type = ty,
770 = ppr n <+> dcolon <+> ppr ty <+> ppr_mbDoc doc
773 %************************************************************************
775 \subsection[InstDecl]{An instance declaration
777 %************************************************************************
780 type LInstDecl name = Located (InstDecl name)
783 = InstDecl (LHsType name) -- Context => Class Instance-type
784 -- Using a polytype means that the renamer conveniently
785 -- figures out the quantified type variables for us.
787 [LSig name] -- User-supplied pragmatic info
788 [LTyClDecl name]-- Associated types (ie, 'TyData' and
791 instance (OutputableBndr name) => Outputable (InstDecl name) where
793 ppr (InstDecl inst_ty binds uprags ats)
794 = vcat [hsep [ptext (sLit "instance"), ppr inst_ty, ptext (sLit "where")]
795 , nest 4 $ vcat (map ppr ats)
796 , nest 4 $ vcat (map ppr uprags)
797 , nest 4 $ pprLHsBinds binds ]
799 -- Extract the declarations of associated types from an instance
801 instDeclATs :: InstDecl name -> [LTyClDecl name]
802 instDeclATs (InstDecl _ _ _ ats) = ats
805 %************************************************************************
807 \subsection[DerivDecl]{A stand-alone instance deriving declaration
809 %************************************************************************
812 type LDerivDecl name = Located (DerivDecl name)
814 data DerivDecl name = DerivDecl (LHsType name)
816 instance (OutputableBndr name) => Outputable (DerivDecl name) where
818 = hsep [ptext (sLit "derived instance"), ppr ty]
821 %************************************************************************
823 \subsection[DefaultDecl]{A @default@ declaration}
825 %************************************************************************
827 There can only be one default declaration per module, but it is hard
828 for the parser to check that; we pass them all through in the abstract
829 syntax, and that restriction must be checked in the front end.
832 type LDefaultDecl name = Located (DefaultDecl name)
834 data DefaultDecl name
835 = DefaultDecl [LHsType name]
837 instance (OutputableBndr name)
838 => Outputable (DefaultDecl name) where
840 ppr (DefaultDecl tys)
841 = ptext (sLit "default") <+> parens (interpp'SP tys)
844 %************************************************************************
846 \subsection{Foreign function interface declaration}
848 %************************************************************************
852 -- foreign declarations are distinguished as to whether they define or use a
855 -- * the Boolean value indicates whether the pre-standard deprecated syntax
858 type LForeignDecl name = Located (ForeignDecl name)
860 data ForeignDecl name
861 = ForeignImport (Located name) (LHsType name) ForeignImport -- defines name
862 | ForeignExport (Located name) (LHsType name) ForeignExport -- uses name
864 -- Specification Of an imported external entity in dependence on the calling
867 data ForeignImport = -- import of a C entity
869 -- * the two strings specifying a header file or library
870 -- may be empty, which indicates the absence of a
871 -- header or object specification (both are not used
872 -- in the case of `CWrapper' and when `CFunction'
873 -- has a dynamic target)
875 -- * the calling convention is irrelevant for code
876 -- generation in the case of `CLabel', but is needed
877 -- for pretty printing
879 -- * `Safety' is irrelevant for `CLabel' and `CWrapper'
881 CImport CCallConv -- ccall or stdcall
882 Safety -- safe or unsafe
883 FastString -- name of C header
884 FastString -- name of library object
885 CImportSpec -- details of the C entity
887 -- import of a .NET function
889 | DNImport DNCallSpec
891 -- details of an external C entity
893 data CImportSpec = CLabel CLabelString -- import address of a C label
894 | CFunction CCallTarget -- static or dynamic function
895 | CWrapper -- wrapper to expose closures
898 -- specification of an externally exported entity in dependence on the calling
901 data ForeignExport = CExport CExportSpec -- contains the calling convention
902 | DNExport -- presently unused
904 -- abstract type imported from .NET
906 data FoType = DNType -- In due course we'll add subtype stuff
907 deriving (Eq) -- Used for equality instance for TyClDecl
910 -- pretty printing of foreign declarations
913 instance OutputableBndr name => Outputable (ForeignDecl name) where
914 ppr (ForeignImport n ty fimport) =
915 hang (ptext (sLit "foreign import") <+> ppr fimport <+> ppr n)
916 2 (dcolon <+> ppr ty)
917 ppr (ForeignExport n ty fexport) =
918 hang (ptext (sLit "foreign export") <+> ppr fexport <+> ppr n)
919 2 (dcolon <+> ppr ty)
921 instance Outputable ForeignImport where
922 ppr (DNImport spec) =
923 ptext (sLit "dotnet") <+> ppr spec
924 ppr (CImport cconv safety header lib spec) =
925 ppr cconv <+> ppr safety <+>
926 char '"' <> pprCEntity header lib spec <> char '"'
928 pprCEntity header lib (CLabel lbl) =
929 ptext (sLit "static") <+> ftext header <+> char '&' <>
930 pprLib lib <> ppr lbl
931 pprCEntity header lib (CFunction (StaticTarget lbl)) =
932 ptext (sLit "static") <+> ftext header <+> char '&' <>
933 pprLib lib <> ppr lbl
934 pprCEntity _ _ (CFunction (DynamicTarget)) =
935 ptext (sLit "dynamic")
936 pprCEntity _ _ (CWrapper) = ptext (sLit "wrapper")
938 pprLib lib | nullFS lib = empty
939 | otherwise = char '[' <> ppr lib <> char ']'
941 instance Outputable ForeignExport where
942 ppr (CExport (CExportStatic lbl cconv)) =
943 ppr cconv <+> char '"' <> ppr lbl <> char '"'
945 ptext (sLit "dotnet") <+> ptext (sLit "\"<unused>\"")
947 instance Outputable FoType where
948 ppr DNType = ptext (sLit "type dotnet")
952 %************************************************************************
954 \subsection{Transformation rules}
956 %************************************************************************
959 type LRuleDecl name = Located (RuleDecl name)
962 = HsRule -- Source rule
963 RuleName -- Rule name
965 [RuleBndr name] -- Forall'd vars; after typechecking this includes tyvars
966 (Located (HsExpr name)) -- LHS
967 NameSet -- Free-vars from the LHS
968 (Located (HsExpr name)) -- RHS
969 NameSet -- Free-vars from the RHS
972 = RuleBndr (Located name)
973 | RuleBndrSig (Located name) (LHsType name)
975 collectRuleBndrSigTys :: [RuleBndr name] -> [LHsType name]
976 collectRuleBndrSigTys bndrs = [ty | RuleBndrSig _ ty <- bndrs]
978 instance OutputableBndr name => Outputable (RuleDecl name) where
979 ppr (HsRule name act ns lhs _fv_lhs rhs _fv_rhs)
980 = sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
981 nest 4 (pp_forall <+> pprExpr (unLoc lhs)),
982 nest 4 (equals <+> pprExpr (unLoc rhs) <+> text "#-}") ]
984 pp_forall | null ns = empty
985 | otherwise = text "forall" <+> fsep (map ppr ns) <> dot
987 instance OutputableBndr name => Outputable (RuleBndr name) where
988 ppr (RuleBndr name) = ppr name
989 ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
992 %************************************************************************
994 \subsection[DocDecl]{Document comments}
996 %************************************************************************
1000 type LDocDecl name = Located (DocDecl name)
1003 = DocCommentNext (HsDoc name)
1004 | DocCommentPrev (HsDoc name)
1005 | DocCommentNamed String (HsDoc name)
1006 | DocGroup Int (HsDoc name)
1008 -- Okay, I need to reconstruct the document comments, but for now:
1009 instance Outputable (DocDecl name) where
1010 ppr _ = text "<document comment>"
1012 docDeclDoc :: DocDecl name -> HsDoc name
1013 docDeclDoc (DocCommentNext d) = d
1014 docDeclDoc (DocCommentPrev d) = d
1015 docDeclDoc (DocCommentNamed _ d) = d
1016 docDeclDoc (DocGroup _ d) = d
1020 %************************************************************************
1022 \subsection[DeprecDecl]{Deprecations}
1024 %************************************************************************
1026 We use exported entities for things to deprecate.
1029 type LWarnDecl name = Located (WarnDecl name)
1031 data WarnDecl name = Warning name WarningTxt
1033 instance OutputableBndr name => Outputable (WarnDecl name) where
1034 ppr (Warning thing txt)
1035 = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]