2
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
\section[RnSource]{Main pass of renamer}
8
rnSrcDecls, addTcgDUs, rnTyClDecls, findSplice
11
#include "HsVersions.h"
13
import {-# SOURCE #-} RnExpr( rnLExpr )
15
import {-# SOURCE #-} TcSplice ( runQuasiQuoteDecl )
19
import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv, rdrNameOcc )
20
import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
22
import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext, rnConDeclFields )
23
import RnBinds ( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
25
import RnEnv ( lookupLocalDataTcNames, lookupLocatedOccRn,
26
lookupTopBndrRn, lookupLocatedTopBndrRn,
27
lookupOccRn, newLocalBndrsRn, bindLocalNamesFV,
28
bindLocatedLocalsFV, bindPatSigTyVarsFV,
29
bindTyVarsRn, bindTyVarsFV, extendTyVarEnvFVRn,
30
bindLocalNames, checkDupRdrNames, mapFvRn
32
import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
33
import HscTypes ( GenAvailInfo(..), availsToNameSet )
34
import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
37
import ForeignCall ( CCallTarget(..) )
39
import HscTypes ( Warnings(..), plusWarns )
40
import Class ( FunDep )
41
import Name ( Name, nameOccName )
47
import Util ( filterOut )
50
import HscTypes ( HscEnv, hsc_dflags )
51
import BasicTypes ( Boxity(..) )
52
import ListSetOps ( findDupsEq )
61
thenM :: Monad a => a b -> (b -> a c) -> a c
64
thenM_ :: Monad a => a b -> a c -> a c
68
@rnSourceDecl@ `renames' declarations.
69
It simultaneously performs dependency analysis and precedence parsing.
70
It also does the following error checks:
73
Checks that tyvars are used properly. This includes checking
74
for undefined tyvars, and tyvars in contexts that are ambiguous.
75
(Some of this checking has now been moved to module @TcMonoType@,
76
since we don't have functional dependency information at this point.)
78
Checks that all variable occurences are defined.
80
Checks the @(..)@ etc constraints in the export list.
85
-- Brings the binders of the group into scope in the appropriate places;
86
-- does NOT assume that anything is in scope already
87
rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
88
-- Rename a HsGroup; used for normal source files *and* hs-boot files
89
rnSrcDecls group@(HsGroup { hs_valds = val_decls,
90
hs_tyclds = tycl_decls,
91
hs_instds = inst_decls,
92
hs_derivds = deriv_decls,
94
hs_warnds = warn_decls,
96
hs_fords = foreign_decls,
97
hs_defds = default_decls,
98
hs_ruleds = rule_decls,
101
-- (A) Process the fixity declarations, creating a mapping from
102
-- FastStrings to FixItems.
103
-- Also checks for duplcates.
104
local_fix_env <- makeMiniFixityEnv fix_decls;
106
-- (B) Bring top level binders (and their fixities) into scope,
107
-- *except* for the value bindings, which get brought in below.
108
-- However *do* include class ops, data constructors
109
-- And for hs-boot files *do* include the value signatures
110
tc_avails <- getLocalNonValBinders group ;
111
tc_envs <- extendGlobalRdrEnvRn tc_avails local_fix_env ;
112
setEnvs tc_envs $ do {
114
failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
116
-- (C) Extract the mapping from data constructors to field names and
117
-- extend the record field env.
118
-- This depends on the data constructors and field names being in
119
-- scope from (B) above
120
inNewEnv (extendRecordFieldEnv tycl_decls inst_decls) $ \ _ -> do {
122
-- (D) Rename the left-hand sides of the value bindings.
123
-- This depends on everything from (B) being in scope,
124
-- and on (C) for resolving record wild cards.
125
-- It uses the fixity env from (A) to bind fixities for view patterns.
126
new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
127
-- bind the LHSes (and their fixities) in the global rdr environment
128
let { val_binders = collectHsValBinders new_lhs ;
129
val_bndr_set = mkNameSet val_binders ;
130
all_bndr_set = val_bndr_set `unionNameSets` availsToNameSet tc_avails ;
131
val_avails = map Avail val_binders
133
(tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
134
setEnvs (tcg_env, tcl_env) $ do {
136
-- Now everything is in scope, as the remaining renaming assumes.
138
-- (E) Rename type and class decls
139
-- (note that value LHSes need to be in scope for default methods)
141
-- You might think that we could build proper def/use information
142
-- for type and class declarations, but they can be involved
143
-- in mutual recursion across modules, and we only do the SCC
144
-- analysis for them in the type checker.
145
-- So we content ourselves with gathering uses only; that
146
-- means we'll only report a declaration as unused if it isn't
147
-- mentioned at all. Ah well.
148
traceRn (text "Start rnTyClDecls") ;
149
(rn_tycl_decls, src_fvs1) <- rnList rnTyClDecl tycl_decls ;
151
-- (F) Rename Value declarations right-hand sides
152
traceRn (text "Start rnmono") ;
153
(rn_val_decls, bind_dus) <- rnTopBindsRHS new_lhs ;
154
traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
156
-- (G) Rename Fixity and deprecations
158
-- Rename fixity declarations and error if we try to
159
-- fix something from another module (duplicates were checked in (A))
160
rn_fix_decls <- rnSrcFixityDecls all_bndr_set fix_decls ;
162
-- Rename deprec decls;
163
-- check for duplicates and ensure that deprecated things are defined locally
164
-- at the moment, we don't keep these around past renaming
165
rn_warns <- rnSrcWarnDecls all_bndr_set warn_decls ;
167
-- (H) Rename Everything else
169
(rn_inst_decls, src_fvs2) <- rnList rnSrcInstDecl inst_decls ;
170
(rn_rule_decls, src_fvs3) <- setOptM Opt_ScopedTypeVariables $
171
rnList rnHsRuleDecl rule_decls ;
172
-- Inside RULES, scoped type variables are on
173
(rn_foreign_decls, src_fvs4) <- rnList rnHsForeignDecl foreign_decls ;
174
(rn_ann_decls, src_fvs5) <- rnList rnAnnDecl ann_decls ;
175
(rn_default_decls, src_fvs6) <- rnList rnDefaultDecl default_decls ;
176
(rn_deriv_decls, src_fvs7) <- rnList rnSrcDerivDecl deriv_decls ;
177
-- Haddock docs; no free vars
178
rn_docs <- mapM (wrapLocM rnDocDecl) docs ;
180
-- (I) Compute the results and return
181
let {rn_group = HsGroup { hs_valds = rn_val_decls,
182
hs_tyclds = rn_tycl_decls,
183
hs_instds = rn_inst_decls,
184
hs_derivds = rn_deriv_decls,
185
hs_fixds = rn_fix_decls,
186
hs_warnds = [], -- warns are returned in the tcg_env
187
-- (see below) not in the HsGroup
188
hs_fords = rn_foreign_decls,
189
hs_annds = rn_ann_decls,
190
hs_defds = rn_default_decls,
191
hs_ruleds = rn_rule_decls,
192
hs_docs = rn_docs } ;
194
tycl_bndrs = hsTyClDeclsBinders rn_tycl_decls rn_inst_decls ;
195
ford_bndrs = hsForeignDeclsBinders rn_foreign_decls ;
196
other_def = (Just (mkNameSet tycl_bndrs `unionNameSets` mkNameSet ford_bndrs), emptyNameSet) ;
197
other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
198
src_fvs5, src_fvs6, src_fvs7] ;
199
-- It is tiresome to gather the binders from type and class decls
201
src_dus = [other_def] `plusDU` bind_dus `plusDU` usesOnly other_fvs ;
202
-- Instance decls may have occurrences of things bound in bind_dus
203
-- so we must put other_fvs last
205
final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
206
in -- we return the deprecs in the env, not in the HsGroup above
207
tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
210
traceRn (text "finish rnSrc" <+> ppr rn_group) ;
211
traceRn (text "finish Dus" <+> ppr src_dus ) ;
212
return (final_tcg_env, rn_group)
215
-- some utils because we do this a bunch above
216
-- compute and install the new env
217
inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
218
inNewEnv env cont = do e <- env
221
rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
222
-- Used for external core
223
rnTyClDecls tycl_decls = do (decls', _fvs) <- rnList rnTyClDecl tycl_decls
226
addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
227
-- This function could be defined lower down in the module hierarchy,
228
-- but there doesn't seem anywhere very logical to put it.
229
addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
231
rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
232
rnList f xs = mapFvRn (wrapLocFstM f) xs
236
%*********************************************************
240
%*********************************************************
243
rnDocDecl :: DocDecl -> RnM DocDecl
244
rnDocDecl (DocCommentNext doc) = do
245
rn_doc <- rnHsDoc doc
246
return (DocCommentNext rn_doc)
247
rnDocDecl (DocCommentPrev doc) = do
248
rn_doc <- rnHsDoc doc
249
return (DocCommentPrev rn_doc)
250
rnDocDecl (DocCommentNamed str doc) = do
251
rn_doc <- rnHsDoc doc
252
return (DocCommentNamed str rn_doc)
253
rnDocDecl (DocGroup lev doc) = do
254
rn_doc <- rnHsDoc doc
255
return (DocGroup lev rn_doc)
259
%*********************************************************
261
Source-code fixity declarations
263
%*********************************************************
266
rnSrcFixityDecls :: NameSet -> [LFixitySig RdrName] -> RnM [LFixitySig Name]
267
-- Rename the fixity decls, so we can put
268
-- the renamed decls in the renamed syntax tree
269
-- Errors if the thing being fixed is not defined locally.
271
-- The returned FixitySigs are not actually used for anything,
272
-- except perhaps the GHCi API
273
rnSrcFixityDecls bound_names fix_decls
274
= do fix_decls <- mapM rn_decl fix_decls
275
return (concat fix_decls)
277
rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
278
-- GHC extension: look up both the tycon and data con
279
-- for con-like things; hence returning a list
280
-- If neither are in scope, report an error; otherwise
281
-- return a fixity sig for each (slightly odd)
282
rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
283
= setSrcSpan name_loc $
284
-- this lookup will fail if the definition isn't local
285
do names <- lookupLocalDataTcNames bound_names what rdr_name
286
return [ L loc (FixitySig (L name_loc name) fixity)
288
what = ptext (sLit "fixity signature")
292
%*********************************************************
294
Source-code deprecations declarations
296
%*********************************************************
298
Check that the deprecated names are defined, are defined locally, and
299
that there are no duplicate deprecations.
301
It's only imported deprecations, dealt with in RnIfaces, that we
302
gather them together.
305
-- checks that the deprecations are defined locally, and that there are no duplicates
306
rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
307
rnSrcWarnDecls _bound_names []
310
rnSrcWarnDecls bound_names decls
311
= do { -- check for duplicates
312
; mapM_ (\ dups -> let (L loc rdr:lrdr':_) = dups
313
in addErrAt loc (dupWarnDecl lrdr' rdr))
315
; pairs_s <- mapM (addLocM rn_deprec) decls
316
; return (WarnSome ((concat pairs_s))) }
318
rn_deprec (Warning rdr_name txt)
319
-- ensures that the names are defined locally
320
= lookupLocalDataTcNames bound_names what rdr_name `thenM` \ names ->
321
return [(nameOccName name, txt) | name <- names]
323
what = ptext (sLit "deprecation")
325
-- look for duplicates among the OccNames;
326
-- we check that the names are defined above
327
-- invt: the lists returned by findDupsEq always have at least two elements
328
warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
329
(map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
331
dupWarnDecl :: Located RdrName -> RdrName -> SDoc
332
-- Located RdrName -> DeprecDecl RdrName -> SDoc
333
dupWarnDecl (L loc _) rdr_name
334
= vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
335
ptext (sLit "also at ") <+> ppr loc]
339
%*********************************************************
341
\subsection{Annotation declarations}
343
%*********************************************************
346
rnAnnDecl :: AnnDecl RdrName -> RnM (AnnDecl Name, FreeVars)
347
rnAnnDecl (HsAnnotation provenance expr) = do
348
(provenance', provenance_fvs) <- rnAnnProvenance provenance
349
(expr', expr_fvs) <- rnLExpr expr
350
return (HsAnnotation provenance' expr', provenance_fvs `plusFV` expr_fvs)
352
rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
353
rnAnnProvenance provenance = do
354
provenance' <- modifyAnnProvenanceNameM lookupTopBndrRn provenance
355
return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
358
%*********************************************************
360
\subsection{Default declarations}
362
%*********************************************************
365
rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
366
rnDefaultDecl (DefaultDecl tys)
367
= mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
368
return (DefaultDecl tys', fvs)
370
doc_str = text "In a `default' declaration"
373
%*********************************************************
375
\subsection{Foreign declarations}
377
%*********************************************************
380
rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
381
rnHsForeignDecl (ForeignImport name ty spec)
382
= getTopEnv `thenM` \ (topEnv :: HscEnv) ->
383
lookupLocatedTopBndrRn name `thenM` \ name' ->
384
rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
386
-- Mark any PackageTarget style imports as coming from the current package
387
let packageId = thisPackage $ hsc_dflags topEnv
388
spec' = patchForeignImport packageId spec
390
in return (ForeignImport name' ty' spec', fvs)
392
rnHsForeignDecl (ForeignExport name ty spec)
393
= lookupLocatedOccRn name `thenM` \ name' ->
394
rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
395
return (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
396
-- NB: a foreign export is an *occurrence site* for name, so
397
-- we add it to the free-variable list. It might, for example,
398
-- be imported from another module
400
fo_decl_msg :: Located RdrName -> SDoc
401
fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
404
-- | For Windows DLLs we need to know what packages imported symbols are from
405
-- to generate correct calls. Imported symbols are tagged with the current
406
-- package, so if they get inlined across a package boundry we'll still
407
-- know where they're from.
409
patchForeignImport :: PackageId -> ForeignImport -> ForeignImport
410
patchForeignImport packageId (CImport cconv safety fs spec)
411
= CImport cconv safety fs (patchCImportSpec packageId spec)
413
patchCImportSpec :: PackageId -> CImportSpec -> CImportSpec
414
patchCImportSpec packageId spec
416
CFunction callTarget -> CFunction $ patchCCallTarget packageId callTarget
419
patchCCallTarget :: PackageId -> CCallTarget -> CCallTarget
420
patchCCallTarget packageId callTarget
422
StaticTarget label Nothing
423
-> StaticTarget label (Just packageId)
431
%*********************************************************
433
\subsection{Instance declarations}
435
%*********************************************************
438
rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
439
rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
440
-- Used for both source and interface file decls
441
= rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
443
-- Rename the bindings
444
-- The typechecker (not the renamer) checks that all
445
-- the bindings are for the right class
447
meth_names = collectMethodBinders mbinds
448
(inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
450
checkDupRdrNames meth_names `thenM_`
451
-- Check that the same method is not given twice in the
452
-- same instance decl instance C T where
456
-- We must use checkDupRdrNames because the Name of the
457
-- method is the Name of the class selector, whose SrcSpan
458
-- points to the class declaration
460
extendTyVarEnvForMethodBinds inst_tyvars (
461
-- (Slightly strangely) the forall-d tyvars scope over
462
-- the method bindings too
463
rnMethodBinds cls (\_ -> []) -- No scoped tyvars
465
) `thenM` \ (mbinds', meth_fvs) ->
466
-- Rename the associated types
467
-- The typechecker (not the renamer) checks that all
468
-- the declarations are for the right class
470
at_names = map (head . hsTyClDeclBinders) ats
472
checkDupRdrNames at_names `thenM_`
473
-- See notes with checkDupRdrNames for methods, above
475
rnATInsts ats `thenM` \ (ats', at_fvs) ->
477
-- Rename the prags and signatures.
478
-- Note that the type variables are not in scope here,
479
-- so that instance Eq a => Eq (T a) where
480
-- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
483
-- But the (unqualified) method names are in scope
485
binders = collectHsBindsBinders mbinds'
486
bndr_set = mkNameSet binders
488
bindLocalNames binders
489
(renameSigs (Just bndr_set) okInstDclSig uprags) `thenM` \ uprags' ->
491
return (InstDecl inst_ty' mbinds' uprags' ats',
492
meth_fvs `plusFV` at_fvs
493
`plusFV` hsSigsFVs uprags'
494
`plusFV` extractHsTyNames inst_ty')
495
-- We return the renamed associated data type declarations so
496
-- that they can be entered into the list of type declarations
497
-- for the binding group, but we also keep a copy in the instance.
498
-- The latter is needed for well-formedness checks in the type
499
-- checker (eg, to ensure that all ATs of the instance actually
500
-- receive a declaration).
501
-- NB: Even the copies in the instance declaration carry copies of
502
-- the instance context after renaming. This is a bit
503
-- strange, but should not matter (and it would be more work
504
-- to remove the context).
507
Renaming of the associated types in instances.
510
rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
511
rnATInsts atDecls = rnList rnATInst atDecls
513
rnATInst tydecl@TyData {} = rnTyClDecl tydecl
514
rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
516
pprPanic "RnSource.rnATInsts: invalid AT instance"
517
(ppr (tcdName tydecl))
520
For the method bindings in class and instance decls, we extend the
521
type variable environment iff -fglasgow-exts
524
extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
525
-> RnM (Bag (LHsBind Name), FreeVars)
526
-> RnM (Bag (LHsBind Name), FreeVars)
527
extendTyVarEnvForMethodBinds tyvars thing_inside
528
= do { scoped_tvs <- xoptM Opt_ScopedTypeVariables
530
extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
535
%*********************************************************
537
\subsection{Stand-alone deriving declarations}
539
%*********************************************************
542
rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
543
rnSrcDerivDecl (DerivDecl ty)
544
= do { standalone_deriv_ok <- xoptM Opt_StandaloneDeriving
545
; unless standalone_deriv_ok (addErr standaloneDerivErr)
546
; ty' <- rnLHsType (text "a deriving decl") ty
547
; let fvs = extractHsTyNames ty'
548
; return (DerivDecl ty', fvs) }
550
standaloneDerivErr :: SDoc
552
= hang (ptext (sLit "Illegal standalone deriving declaration"))
553
2 (ptext (sLit "Use -XStandaloneDeriving to enable this extension"))
556
%*********************************************************
560
%*********************************************************
563
rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
564
rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
565
= bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
566
bindLocatedLocalsFV (map get_var vars) $ \ ids ->
567
do { (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
568
-- NB: The binders in a rule are always Ids
569
-- We don't (yet) support type variables
571
; (lhs', fv_lhs') <- rnLExpr lhs
572
; (rhs', fv_rhs') <- rnLExpr rhs
574
; checkValidRule rule_name ids lhs' fv_lhs'
576
; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
577
fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
579
doc = text "In the transformation rule" <+> ftext rule_name
581
get_var (RuleBndr v) = v
582
get_var (RuleBndrSig v _) = v
584
rn_var (RuleBndr (L loc _), id)
585
= return (RuleBndr (L loc id), emptyFVs)
586
rn_var (RuleBndrSig (L loc _) t, id)
587
= rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
588
return (RuleBndrSig (L loc id) t', fvs)
590
badRuleVar :: FastString -> Name -> SDoc
592
= sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
593
ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
594
ptext (sLit "does not appear on left hand side")]
597
Note [Rule LHS validity checking]
598
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
599
Check the shape of a transformation rule LHS. Currently we only allow
600
LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
601
@forall@'d variables.
603
We used restrict the form of the 'ei' to prevent you writing rules
604
with LHSs with a complicated desugaring (and hence unlikely to match);
605
(e.g. a case expression is not allowed: too elaborate.)
607
But there are legitimate non-trivial args ei, like sections and
608
lambdas. So it seems simmpler not to check at all, and that is why
609
check_e is commented out.
612
checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
613
checkValidRule rule_name ids lhs' fv_lhs'
614
= do { -- Check for the form of the LHS
615
case (validRuleLhs ids lhs') of
617
Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)
619
-- Check that LHS vars are all bound
620
; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
621
; mapM_ (addErr . badRuleVar rule_name) bad_vars }
623
validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
625
-- Just e => Not ok, and e is the offending expression
626
validRuleLhs foralls lhs
629
checkl (L _ e) = check e
631
check (OpApp e1 op _ e2) = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
632
check (HsApp e1 e2) = checkl e1 `mplus` checkl_e e2
633
check (HsVar v) | v `notElem` foralls = Nothing
634
check other = Just other -- Failure
637
checkl_e (L _ _e) = Nothing -- Was (check_e e); see Note [Rule LHS validity checking]
639
{- Commented out; see Note [Rule LHS validity checking] above
640
check_e (HsVar v) = Nothing
641
check_e (HsPar e) = checkl_e e
642
check_e (HsLit e) = Nothing
643
check_e (HsOverLit e) = Nothing
645
check_e (OpApp e1 op _ e2) = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
646
check_e (HsApp e1 e2) = checkl_e e1 `mplus` checkl_e e2
647
check_e (NegApp e _) = checkl_e e
648
check_e (ExplicitList _ es) = checkl_es es
649
check_e other = Just other -- Fails
651
checkl_es es = foldr (mplus . checkl_e) Nothing es
654
badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
655
badRuleLhsErr name lhs bad_e
656
= sep [ptext (sLit "Rule") <+> ftext name <> colon,
657
nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
658
ptext (sLit "in left-hand side:") <+> ppr lhs])]
660
ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
664
%*********************************************************
666
\subsection{Type, class and iface sig declarations}
668
%*********************************************************
670
@rnTyDecl@ uses the `global name function' to create a new type
671
declaration in which local names have been replaced by their original
672
names, reporting any unknown names.
674
Renaming type variables is a pain. Because they now contain uniques,
675
it is necessary to pass in an association list which maps a parsed
676
tyvar to its @Name@ representation.
677
In some cases (type signatures of values),
678
it is even necessary to go over the type first
679
in order to get the set of tyvars used by it, make an assoc list,
680
and then go over it again to rename the tyvars!
681
However, we can also do some scoping checks at the same time.
684
rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
685
rnTyClDecl (ForeignType {tcdLName = name, tcdExtName = ext_name})
686
= lookupLocatedTopBndrRn name `thenM` \ name' ->
687
return (ForeignType {tcdLName = name', tcdExtName = ext_name},
690
-- all flavours of type family declarations ("type family", "newtype fanily",
691
-- and "data family")
692
rnTyClDecl tydecl@TyFamily {} = rnFamily tydecl bindTyVarsFV
694
-- "data", "newtype", "data instance, and "newtype instance" declarations
695
rnTyClDecl tydecl@TyData {tcdND = new_or_data, tcdCtxt = context,
696
tcdLName = tycon, tcdTyVars = tyvars,
697
tcdTyPats = typats, tcdCons = condecls,
698
tcdKindSig = sig, tcdDerivs = derivs}
699
= do { tycon' <- if isFamInstDecl tydecl
700
then lookupLocatedOccRn tycon -- may be imported family
701
else lookupLocatedTopBndrRn tycon
702
; checkTc (h98_style || null (unLoc context))
703
(badGadtStupidTheta tycon)
704
; ((tyvars', context', typats', derivs'), stuff_fvs)
705
<- bindTyVarsFV tyvars $ \ tyvars' -> do
706
-- Checks for distinct tyvars
707
{ context' <- rnContext data_doc context
708
; (typats', fvs1) <- rnTyPats data_doc tycon' typats
709
; (derivs', fvs2) <- rn_derivs derivs
710
; let fvs = fvs1 `plusFV` fvs2 `plusFV`
711
extractHsCtxtTyNames context'
712
; return ((tyvars', context', typats', derivs'), fvs) }
714
-- For the constructor declarations, bring into scope the tyvars
715
-- bound by the header, but *only* in the H98 case
716
-- Reason: for GADTs, the type variables in the declaration
717
-- do not scope over the constructor signatures
718
-- data T a where { T1 :: forall b. b-> b }
719
; let tc_tvs_in_scope | h98_style = hsLTyVarNames tyvars'
721
; (condecls', con_fvs) <- bindLocalNamesFV tc_tvs_in_scope $
723
-- No need to check for duplicate constructor decls
724
-- since that is done by RnNames.extendGlobalRdrEnvRn
726
; return (TyData {tcdND = new_or_data, tcdCtxt = context',
727
tcdLName = tycon', tcdTyVars = tyvars',
728
tcdTyPats = typats', tcdKindSig = sig,
729
tcdCons = condecls', tcdDerivs = derivs'},
730
con_fvs `plusFV` stuff_fvs)
733
h98_style = case condecls of -- Note [Stupid theta]
734
L _ (ConDecl { con_res = ResTyGADT {} }) : _ -> False
737
data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
739
rn_derivs Nothing = return (Nothing, emptyFVs)
740
rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
741
return (Just ds', extractHsTyNames_s ds')
743
-- "type" and "type instance" declarations
744
rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
745
tcdTyPats = typats, tcdSynRhs = ty})
746
= bindTyVarsFV tyvars $ \ tyvars' -> do
747
{ -- Checks for distinct tyvars
748
name' <- if isFamInstDecl tydecl
749
then lookupLocatedOccRn name -- may be imported family
750
else lookupLocatedTopBndrRn name
751
; (typats',fvs1) <- rnTyPats syn_doc name' typats
752
; (ty', fvs2) <- rnHsTypeFVs syn_doc ty
753
; return (TySynonym { tcdLName = name', tcdTyVars = tyvars'
754
, tcdTyPats = typats', tcdSynRhs = ty'},
755
fvs1 `plusFV` fvs2) }
757
syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
759
rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
760
tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
761
tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
762
= do { cname' <- lookupLocatedTopBndrRn cname
764
-- Tyvars scope over superclass context and method signatures
765
; ((tyvars', context', fds', ats', sigs'), stuff_fvs)
766
<- bindTyVarsFV tyvars $ \ tyvars' -> do
767
-- Checks for distinct tyvars
768
{ context' <- rnContext cls_doc context
769
; fds' <- rnFds cls_doc fds
770
; (ats', at_fvs) <- rnATs ats
771
; sigs' <- renameSigs Nothing okClsDclSig sigs
772
; let fvs = at_fvs `plusFV`
773
extractHsCtxtTyNames context' `plusFV`
775
-- The fundeps have no free variables
776
; return ((tyvars', context', fds', ats', sigs'), fvs) }
778
-- No need to check for duplicate associated type decls
779
-- since that is done by RnNames.extendGlobalRdrEnvRn
781
-- Check the signatures
782
-- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
783
; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
784
; checkDupRdrNames sig_rdr_names_w_locs
785
-- Typechecker is responsible for checking that we only
786
-- give default-method bindings for things in this class.
787
-- The renamer *could* check this for class decls, but can't
788
-- for instance decls.
790
-- The newLocals call is tiresome: given a generic class decl
793
-- op {| x+y |} (Inl a) = ...
794
-- op {| x+y |} (Inr b) = ...
795
-- op {| a*b |} (a*b) = ...
796
-- we want to name both "x" tyvars with the same unique, so that they are
797
-- easy to group together in the typechecker.
798
; (mbinds', meth_fvs)
799
<- extendTyVarEnvForMethodBinds tyvars' $ do
800
{ name_env <- getLocalRdrEnv
801
; let gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
802
not (unLoc tv `elemLocalRdrEnv` name_env) ]
803
-- No need to check for duplicate method signatures
804
-- since that is done by RnNames.extendGlobalRdrEnvRn
805
-- and the methods are already in scope
806
; gen_tyvars <- newLocalBndrsRn gen_rdr_tyvars_w_locs
807
; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
810
; docs' <- mapM (wrapLocM rnDocDecl) docs
812
; return (ClassDecl { tcdCtxt = context', tcdLName = cname',
813
tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
814
tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
815
meth_fvs `plusFV` stuff_fvs) }
817
cls_doc = text "In the declaration for class" <+> ppr cname
819
badGadtStupidTheta :: Located RdrName -> SDoc
821
= vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
822
ptext (sLit "(You can put a context on each contructor, though.)")]
827
Trac #3850 complains about a regression wrt 6.10 for
829
There is no reason not to allow the stupid theta if there are no data
830
constructors. It's still stupid, but does no harm, and I don't want
831
to cause programs to break unnecessarily (notably HList). So if there
832
are no data constructors we allow h98_style = True
835
%*********************************************************
837
\subsection{Support code for type/data declarations}
839
%*********************************************************
842
rnTyPats :: SDoc -> Located Name -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name], FreeVars)
843
-- Although, we are processing type patterns here, all type variables will
844
-- already be in scope (they are the same as in the 'tcdTyVars' field of the
845
-- type declaration to which these patterns belong)
847
= return (Nothing, emptyFVs)
848
rnTyPats doc tc (Just typats)
849
= do { typats' <- rnLHsTypes doc typats
850
; let fvs = addOneFV (extractHsTyNames_s typats') (unLoc tc)
851
-- type instance => use, hence addOneFV
852
; return (Just typats', fvs) }
854
rnConDecls :: [LConDecl RdrName] -> RnM ([LConDecl Name], FreeVars)
856
= do { condecls' <- mapM (wrapLocM rnConDecl) condecls
857
; return (condecls', plusFVs (map conDeclFVs condecls')) }
859
rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
860
rnConDecl decl@(ConDecl { con_name = name, con_qvars = tvs
861
, con_cxt = cxt, con_details = details
862
, con_res = res_ty, con_doc = mb_doc
863
, con_old_rec = old_rec, con_explicit = expl })
864
= do { addLocM checkConName name
865
; when old_rec (addWarn (deprecRecSyntax decl))
866
; new_name <- lookupLocatedTopBndrRn name
868
-- For H98 syntax, the tvs are the existential ones
869
-- For GADT syntax, the tvs are all the quantified tyvars
870
-- Hence the 'filter' in the ResTyH98 case only
871
; rdr_env <- getLocalRdrEnv
872
; let in_scope = (`elemLocalRdrEnv` rdr_env) . unLoc
873
arg_tys = hsConDeclArgTys details
874
implicit_tvs = case res_ty of
875
ResTyH98 -> filterOut in_scope (get_rdr_tvs arg_tys)
876
ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
877
new_tvs = case expl of
879
Implicit -> userHsTyVarBndrs implicit_tvs
881
; mb_doc' <- rnMbLHsDoc mb_doc
883
; bindTyVarsRn new_tvs $ \new_tyvars -> do
884
{ new_context <- rnContext doc cxt
885
; new_details <- rnConDeclDetails doc details
886
; (new_details', new_res_ty) <- rnConResult doc new_details res_ty
887
; return (decl { con_name = new_name, con_qvars = new_tyvars, con_cxt = new_context
888
, con_details = new_details', con_res = new_res_ty, con_doc = mb_doc' }) }}
890
doc = text "In the definition of data constructor" <+> quotes (ppr name)
891
get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
894
-> HsConDetails (LHsType Name) [ConDeclField Name]
896
-> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
898
rnConResult _ details ResTyH98 = return (details, ResTyH98)
899
rnConResult doc details (ResTyGADT ty)
900
= do { ty' <- rnLHsType doc ty
901
; let (arg_tys, res_ty) = splitHsFunType ty'
902
-- We can finally split it up,
903
-- now the renamer has dealt with fixities
904
-- See Note [Sorting out the result type] in RdrHsSyn
906
details' = case details of
908
PrefixCon {} -> PrefixCon arg_tys
909
InfixCon {} -> pprPanic "rnConResult" (ppr ty)
910
-- See Note [Sorting out the result type] in RdrHsSyn
912
; when (not (null arg_tys) && case details of { RecCon {} -> True; _ -> False })
913
(addErr (badRecResTy doc))
914
; return (details', ResTyGADT res_ty) }
916
rnConDeclDetails :: SDoc
917
-> HsConDetails (LHsType RdrName) [ConDeclField RdrName]
918
-> RnM (HsConDetails (LHsType Name) [ConDeclField Name])
919
rnConDeclDetails doc (PrefixCon tys)
920
= mapM (rnLHsType doc) tys `thenM` \ new_tys ->
921
return (PrefixCon new_tys)
923
rnConDeclDetails doc (InfixCon ty1 ty2)
924
= rnLHsType doc ty1 `thenM` \ new_ty1 ->
925
rnLHsType doc ty2 `thenM` \ new_ty2 ->
926
return (InfixCon new_ty1 new_ty2)
928
rnConDeclDetails doc (RecCon fields)
929
= do { new_fields <- rnConDeclFields doc fields
930
-- No need to check for duplicate fields
931
-- since that is done by RnNames.extendGlobalRdrEnvRn
932
; return (RecCon new_fields) }
934
-- Rename family declarations
936
-- * This function is parametrised by the routine handling the index
937
-- variables. On the toplevel, these are defining occurences, whereas they
938
-- are usage occurences for associated types.
940
rnFamily :: TyClDecl RdrName
941
-> ([LHsTyVarBndr RdrName] ->
942
([LHsTyVarBndr Name] -> RnM (TyClDecl Name, FreeVars)) ->
943
RnM (TyClDecl Name, FreeVars))
944
-> RnM (TyClDecl Name, FreeVars)
946
rnFamily (tydecl@TyFamily {tcdFlavour = flavour,
947
tcdLName = tycon, tcdTyVars = tyvars})
949
do { bindIdxVars tyvars $ \tyvars' -> do {
950
; tycon' <- lookupLocatedTopBndrRn tycon
951
; return (TyFamily {tcdFlavour = flavour, tcdLName = tycon',
952
tcdTyVars = tyvars', tcdKind = tcdKind tydecl},
955
rnFamily d _ = pprPanic "rnFamily" (ppr d)
957
-- Rename associated type declarations (in classes)
959
-- * This can be family declarations and (default) type instances
961
rnATs :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
962
rnATs ats = mapFvRn (wrapLocFstM rn_at) ats
964
rn_at (tydecl@TyFamily {}) = rnFamily tydecl lookupIdxVars
965
rn_at (tydecl@TySynonym {}) =
967
unless (isNothing (tcdTyPats tydecl)) $ addErr noPatterns
969
rn_at _ = panic "RnSource.rnATs: invalid TyClDecl"
971
lookupIdxVars tyvars cont =
972
do { checkForDups tyvars
973
; tyvars' <- mapM lookupIdxVar tyvars
976
-- Type index variables must be class parameters, which are the only
977
-- type variables in scope at this point.
978
lookupIdxVar (L l tyvar) =
980
name' <- lookupOccRn (hsTyVarName tyvar)
981
return $ L l (replaceTyVarName tyvar name')
983
-- Type variable may only occur once.
985
checkForDups [] = return ()
986
checkForDups (L loc tv:ltvs) =
987
do { setSrcSpan loc $
988
when (hsTyVarName tv `ltvElem` ltvs) $
989
addErr (repeatedTyVar tv)
993
_ `ltvElem` [] = False
994
rdrName `ltvElem` (L _ tv:ltvs)
995
| rdrName == hsTyVarName tv = True
996
| otherwise = rdrName `ltvElem` ltvs
998
deprecRecSyntax :: ConDecl RdrName -> SDoc
1000
= vcat [ ptext (sLit "Declaration of") <+> quotes (ppr (con_name decl))
1001
<+> ptext (sLit "uses deprecated syntax")
1002
, ptext (sLit "Instead, use the form")
1003
, nest 2 (ppr decl) ] -- Pretty printer uses new form
1005
badRecResTy :: SDoc -> SDoc
1006
badRecResTy doc = ptext (sLit "Malformed constructor signature") $$ doc
1009
noPatterns = text "Default definition for an associated synonym cannot have"
1010
<+> text "type pattern"
1012
repeatedTyVar :: HsTyVarBndr RdrName -> SDoc
1013
repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
1016
-- This data decl will parse OK
1018
-- treating "a" as the constructor.
1019
-- It is really hard to make the parser spot this malformation.
1020
-- So the renamer has to check that the constructor is legal
1022
-- We can get an operator as the constructor, even in the prefix form:
1023
-- data T = :% Int Int
1024
-- from interface files, which always print in prefix form
1026
checkConName :: RdrName -> TcRn ()
1027
checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1029
badDataCon :: RdrName -> SDoc
1031
= hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
1035
%*********************************************************
1037
\subsection{Support code for type/data declarations}
1039
%*********************************************************
1041
Get the mapping from constructors to fields for this module.
1042
It's convenient to do this after the data type decls have been renamed
1044
extendRecordFieldEnv :: [LTyClDecl RdrName] -> [LInstDecl RdrName] -> TcM TcGblEnv
1045
extendRecordFieldEnv tycl_decls inst_decls
1046
= do { tcg_env <- getGblEnv
1047
; field_env' <- foldrM get_con (tcg_field_env tcg_env) all_data_cons
1048
; return (tcg_env { tcg_field_env = field_env' }) }
1050
-- we want to lookup:
1051
-- (a) a datatype constructor
1052
-- (b) a record field
1053
-- knowing that they're from this module.
1054
-- lookupLocatedTopBndrRn does this, because it does a lookupGreLocalRn,
1055
-- which keeps only the local ones.
1056
lookup x = do { x' <- lookupLocatedTopBndrRn x
1057
; return $ unLoc x'}
1059
all_data_cons :: [ConDecl RdrName]
1060
all_data_cons = [con | L _ (TyData { tcdCons = cons }) <- all_tycl_decls
1062
all_tycl_decls = at_tycl_decls ++ tycl_decls
1063
at_tycl_decls = instDeclATs inst_decls -- Do not forget associated types!
1065
get_con (ConDecl { con_name = con, con_details = RecCon flds })
1066
(RecFields env fld_set)
1067
= do { con' <- lookup con
1068
; flds' <- mapM lookup (map cd_fld_name flds)
1069
; let env' = extendNameEnv env con' flds'
1070
fld_set' = addListToNameSet fld_set flds'
1071
; return $ (RecFields env' fld_set') }
1072
get_con _ env = return env
1075
%*********************************************************
1077
\subsection{Support code to rename types}
1079
%*********************************************************
1082
rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
1085
= mapM (wrapLocM rn_fds) fds
1088
= rnHsTyVars doc tys1 `thenM` \ tys1' ->
1089
rnHsTyVars doc tys2 `thenM` \ tys2' ->
1090
return (tys1', tys2')
1092
rnHsTyVars :: SDoc -> [RdrName] -> RnM [Name]
1093
rnHsTyVars doc tvs = mapM (rnHsTyVar doc) tvs
1095
rnHsTyVar :: SDoc -> RdrName -> RnM Name
1096
rnHsTyVar _doc tyvar = lookupOccRn tyvar
1100
%*********************************************************
1104
%*********************************************************
1106
This code marches down the declarations, looking for the first
1107
Template Haskell splice. As it does so it
1108
a) groups the declarations into a HsGroup
1109
b) runs any top-level quasi-quotes
1112
findSplice :: [LHsDecl RdrName] -> RnM (HsGroup RdrName, Maybe (SpliceDecl RdrName, [LHsDecl RdrName]))
1113
findSplice ds = addl emptyRdrGroup ds
1115
addl :: HsGroup RdrName -> [LHsDecl RdrName]
1116
-> RnM (HsGroup RdrName, Maybe (SpliceDecl RdrName, [LHsDecl RdrName]))
1117
-- This stuff reverses the declarations (again) but it doesn't matter
1118
addl gp [] = return (gp, Nothing)
1119
addl gp (L l d : ds) = add gp l d ds
1122
add :: HsGroup RdrName -> SrcSpan -> HsDecl RdrName -> [LHsDecl RdrName]
1123
-> RnM (HsGroup RdrName, Maybe (SpliceDecl RdrName, [LHsDecl RdrName]))
1125
add gp loc (SpliceD splice@(SpliceDecl _ flag)) ds
1126
= do { -- We've found a top-level splice. If it is an *implicit* one
1127
-- (i.e. a naked top level expression)
1129
Explicit -> return ()
1130
Implicit -> do { th_on <- xoptM Opt_TemplateHaskell
1131
; unless th_on $ setSrcSpan loc $
1132
failWith badImplicitSplice }
1134
; return (gp, Just (splice, ds)) }
1136
badImplicitSplice = ptext (sLit "Parse error: naked expression at top level")
1139
add _ _ (QuasiQuoteD qq) _
1140
= pprPanic "Can't do QuasiQuote declarations without GHCi" (ppr qq)
1142
add gp _ (QuasiQuoteD qq) ds -- Expand quasiquotes
1143
= do { ds' <- runQuasiQuoteDecl qq
1144
; addl gp (ds' ++ ds) }
1147
-- Class declarations: pull out the fixity signatures to the top
1148
add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs}) l (TyClD d) ds
1150
= let fsigs = [ L l f | L l (FixSig f) <- tcdSigs d ] in
1151
addl (gp { hs_tyclds = L l d : ts, hs_fixds = fsigs ++ fs}) ds
1153
= addl (gp { hs_tyclds = L l d : ts }) ds
1155
-- Signatures: fixity sigs go a different place than all others
1156
add gp@(HsGroup {hs_fixds = ts}) l (SigD (FixSig f)) ds
1157
= addl (gp {hs_fixds = L l f : ts}) ds
1158
add gp@(HsGroup {hs_valds = ts}) l (SigD d) ds
1159
= addl (gp {hs_valds = add_sig (L l d) ts}) ds
1161
-- Value declarations: use add_bind
1162
add gp@(HsGroup {hs_valds = ts}) l (ValD d) ds
1163
= addl (gp { hs_valds = add_bind (L l d) ts }) ds
1165
-- The rest are routine
1166
add gp@(HsGroup {hs_instds = ts}) l (InstD d) ds
1167
= addl (gp { hs_instds = L l d : ts }) ds
1168
add gp@(HsGroup {hs_derivds = ts}) l (DerivD d) ds
1169
= addl (gp { hs_derivds = L l d : ts }) ds
1170
add gp@(HsGroup {hs_defds = ts}) l (DefD d) ds
1171
= addl (gp { hs_defds = L l d : ts }) ds
1172
add gp@(HsGroup {hs_fords = ts}) l (ForD d) ds
1173
= addl (gp { hs_fords = L l d : ts }) ds
1174
add gp@(HsGroup {hs_warnds = ts}) l (WarningD d) ds
1175
= addl (gp { hs_warnds = L l d : ts }) ds
1176
add gp@(HsGroup {hs_annds = ts}) l (AnnD d) ds
1177
= addl (gp { hs_annds = L l d : ts }) ds
1178
add gp@(HsGroup {hs_ruleds = ts}) l (RuleD d) ds
1179
= addl (gp { hs_ruleds = L l d : ts }) ds
1180
add gp l (DocD d) ds
1181
= addl (gp { hs_docs = (L l d) : (hs_docs gp) }) ds
1183
add_bind :: LHsBind a -> HsValBinds a -> HsValBinds a
1184
add_bind b (ValBindsIn bs sigs) = ValBindsIn (bs `snocBag` b) sigs
1185
add_bind _ (ValBindsOut {}) = panic "RdrHsSyn:add_bind"
1187
add_sig :: LSig a -> HsValBinds a -> HsValBinds a
1188
add_sig s (ValBindsIn bs sigs) = ValBindsIn bs (s:sigs)
1189
add_sig _ (ValBindsOut {}) = panic "RdrHsSyn:add_sig"
b'\\ No newline at end of file'