2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnSource]{Main pass of renamer}
9 rnTyClDecls, checkModDeprec,
13 #include "HsVersions.h"
15 import {-# SOURCE #-} RnExpr( rnLExpr )
18 import RdrName ( RdrName, isRdrDataCon, elemLocalRdrEnv, globalRdrEnvElts,
19 GlobalRdrElt(..), isLocalGRE )
20 import RdrHsSyn ( extractGenericPatTyVars, extractHsRhoRdrTyVars )
22 import RnTypes ( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext )
23 import RnBinds ( rnTopBinds, rnMethodBinds, renameSigs, mkSigTvFn )
24 import RnEnv ( lookupLocalDataTcNames,
25 lookupLocatedTopBndrRn, lookupLocatedOccRn,
26 lookupOccRn, newLocalsRn,
27 bindLocatedLocalsFV, bindPatSigTyVarsFV,
28 bindTyVarsRn, extendTyVarEnvFVRn,
29 bindLocalNames, checkDupNames, mapFvRn
33 import HscTypes ( FixityEnv, FixItem(..),
34 Deprecations, Deprecs(..), DeprecTxt, plusDeprecs )
35 import Class ( FunDep )
36 import Name ( Name, nameOccName )
39 import OccName ( occEnvElts )
41 import SrcLoc ( Located(..), unLoc, noLoc )
42 import DynFlags ( DynFlag(..) )
43 import Maybes ( seqMaybe )
44 import Maybe ( isNothing )
45 import BasicTypes ( Boxity(..) )
48 @rnSourceDecl@ `renames' declarations.
49 It simultaneously performs dependency analysis and precedence parsing.
50 It also does the following error checks:
53 Checks that tyvars are used properly. This includes checking
54 for undefined tyvars, and tyvars in contexts that are ambiguous.
55 (Some of this checking has now been moved to module @TcMonoType@,
56 since we don't have functional dependency information at this point.)
58 Checks that all variable occurences are defined.
60 Checks the @(..)@ etc constraints in the export list.
65 rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
67 rnSrcDecls (HsGroup { hs_valds = val_decls,
68 hs_tyclds = tycl_decls,
69 hs_instds = inst_decls,
71 hs_depds = deprec_decls,
72 hs_fords = foreign_decls,
73 hs_defds = default_decls,
74 hs_ruleds = rule_decls })
76 = do { -- Deal with deprecations (returns only the extra deprecations)
77 deprecs <- rnSrcDeprecDecls deprec_decls ;
78 updGblEnv (\gbl -> gbl { tcg_deprecs = tcg_deprecs gbl `plusDeprecs` deprecs })
81 -- Deal with top-level fixity decls
82 -- (returns the total new fixity env)
83 rn_fix_decls <- rnSrcFixityDecls fix_decls ;
84 fix_env <- rnSrcFixityDeclsEnv rn_fix_decls ;
85 updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
88 -- Rename other declarations
89 traceRn (text "Start rnmono") ;
90 (rn_val_decls, bind_dus) <- rnTopBinds val_decls ;
91 traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;
93 -- You might think that we could build proper def/use information
94 -- for type and class declarations, but they can be involved
95 -- in mutual recursion across modules, and we only do the SCC
96 -- analysis for them in the type checker.
97 -- So we content ourselves with gathering uses only; that
98 -- means we'll only report a declaration as unused if it isn't
99 -- mentioned at all. Ah well.
100 (rn_tycl_decls, src_fvs1)
101 <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls ;
102 (rn_inst_decls, src_fvs2)
103 <- mapFvRn (wrapLocFstM rnSrcInstDecl) inst_decls ;
104 (rn_rule_decls, src_fvs3)
105 <- mapFvRn (wrapLocFstM rnHsRuleDecl) rule_decls ;
106 (rn_foreign_decls, src_fvs4)
107 <- mapFvRn (wrapLocFstM rnHsForeignDecl) foreign_decls ;
108 (rn_default_decls, src_fvs5)
109 <- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
112 rn_group = HsGroup { hs_valds = rn_val_decls,
113 hs_tyclds = rn_tycl_decls,
114 hs_instds = rn_inst_decls,
115 hs_fixds = rn_fix_decls,
117 hs_fords = rn_foreign_decls,
118 hs_defds = rn_default_decls,
119 hs_ruleds = rn_rule_decls } ;
121 other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3,
122 src_fvs4, src_fvs5] ;
123 src_dus = bind_dus `plusDU` usesOnly other_fvs
124 -- Note: src_dus will contain *uses* for locally-defined types
125 -- and classes, but no *defs* for them. (Because rnTyClDecl
126 -- returns only the uses.) This is a little
127 -- surprising but it doesn't actually matter at all.
130 traceRn (text "finish rnSrc" <+> ppr rn_group) ;
131 traceRn (text "finish Dus" <+> ppr src_dus ) ;
132 tcg_env <- getGblEnv ;
133 return (tcg_env `addTcgDUs` src_dus, rn_group)
136 rnTyClDecls :: [LTyClDecl RdrName] -> RnM [LTyClDecl Name]
137 rnTyClDecls tycl_decls = do
138 (decls', fvs) <- mapFvRn (wrapLocFstM rnTyClDecl) tycl_decls
141 addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv
142 addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
146 %*********************************************************
148 Source-code fixity declarations
150 %*********************************************************
153 rnSrcFixityDecls :: [LFixitySig RdrName] -> RnM [LFixitySig Name]
154 rnSrcFixityDecls fix_decls
155 = do fix_decls <- mapM rnFixityDecl fix_decls
156 return (concat fix_decls)
158 rnFixityDecl :: LFixitySig RdrName -> RnM [LFixitySig Name]
159 rnFixityDecl (L loc (FixitySig (L nameLoc rdr_name) fixity))
160 = setSrcSpan nameLoc $
161 -- GHC extension: look up both the tycon and data con
162 -- for con-like things
163 -- If neither are in scope, report an error; otherwise
164 -- add both to the fixity env
165 do names <- lookupLocalDataTcNames rdr_name
166 return [ L loc (FixitySig (L nameLoc name) fixity)
169 rnSrcFixityDeclsEnv :: [LFixitySig Name] -> RnM FixityEnv
170 rnSrcFixityDeclsEnv fix_decls
171 = getGblEnv `thenM` \ gbl_env ->
172 foldlM rnFixityDeclEnv (tcg_fix_env gbl_env)
173 fix_decls `thenM` \ fix_env ->
174 traceRn (text "fixity env" <+> pprFixEnv fix_env) `thenM_`
177 rnFixityDeclEnv :: FixityEnv -> LFixitySig Name -> RnM FixityEnv
178 rnFixityDeclEnv fix_env (L loc (FixitySig (L nameLoc name) fixity))
179 = case lookupNameEnv fix_env name of
180 Just (FixItem _ _ loc')
181 -> do addLocErr (L nameLoc name) (dupFixityDecl loc')
184 -> return (extendNameEnv fix_env name fix_item)
185 where fix_item = FixItem (nameOccName name) fixity nameLoc
187 pprFixEnv :: FixityEnv -> SDoc
189 = pprWithCommas (\ (FixItem n f _) -> ppr f <+> ppr n)
192 dupFixityDecl loc rdr_name
193 = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
194 ptext SLIT("also at ") <+> ppr loc
199 %*********************************************************
201 Source-code deprecations declarations
203 %*********************************************************
205 For deprecations, all we do is check that the names are in scope.
206 It's only imported deprecations, dealt with in RnIfaces, that we
207 gather them together.
210 rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations
214 rnSrcDeprecDecls decls
215 = mappM (addLocM rn_deprec) decls `thenM` \ pairs_s ->
216 returnM (DeprecSome (mkNameEnv (concat pairs_s)))
218 rn_deprec (Deprecation rdr_name txt)
219 = lookupLocalDataTcNames rdr_name `thenM` \ names ->
220 returnM [(name, (nameOccName name, txt)) | name <- names]
222 checkModDeprec :: Maybe DeprecTxt -> Deprecations
223 -- Check for a module deprecation; done once at top level
224 checkModDeprec Nothing = NoDeprecs
225 checkModDeprec (Just txt) = DeprecAll txt
228 %*********************************************************
230 \subsection{Source code declarations}
232 %*********************************************************
235 rnDefaultDecl (DefaultDecl tys)
236 = mapFvRn (rnHsTypeFVs doc_str) tys `thenM` \ (tys', fvs) ->
237 returnM (DefaultDecl tys', fvs)
239 doc_str = text "In a `default' declaration"
242 %*********************************************************
244 \subsection{Foreign declarations}
246 %*********************************************************
249 rnHsForeignDecl (ForeignImport name ty spec isDeprec)
250 = lookupLocatedTopBndrRn name `thenM` \ name' ->
251 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
252 returnM (ForeignImport name' ty' spec isDeprec, fvs)
254 rnHsForeignDecl (ForeignExport name ty spec isDeprec)
255 = lookupLocatedOccRn name `thenM` \ name' ->
256 rnHsTypeFVs (fo_decl_msg name) ty `thenM` \ (ty', fvs) ->
257 returnM (ForeignExport name' ty' spec isDeprec, fvs )
258 -- NB: a foreign export is an *occurrence site* for name, so
259 -- we add it to the free-variable list. It might, for example,
260 -- be imported from another module
262 fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
266 %*********************************************************
268 \subsection{Instance declarations}
270 %*********************************************************
273 rnSrcInstDecl (InstDecl inst_ty mbinds uprags)
274 -- Used for both source and interface file decls
275 = rnHsSigType (text "an instance decl") inst_ty `thenM` \ inst_ty' ->
277 -- Rename the bindings
278 -- The typechecker (not the renamer) checks that all
279 -- the bindings are for the right class
281 meth_doc = text "In the bindings in an instance declaration"
282 meth_names = collectHsBindLocatedBinders mbinds
283 (inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
285 checkDupNames meth_doc meth_names `thenM_`
286 extendTyVarEnvForMethodBinds inst_tyvars (
287 -- (Slightly strangely) the forall-d tyvars scope over
288 -- the method bindings too
289 rnMethodBinds cls (\n->[]) -- No scoped tyvars
291 ) `thenM` \ (mbinds', meth_fvs) ->
292 -- Rename the prags and signatures.
293 -- Note that the type variables are not in scope here,
294 -- so that instance Eq a => Eq (T a) where
295 -- {-# SPECIALISE instance Eq a => Eq (T [a]) #-}
298 -- But the (unqualified) method names are in scope
300 binders = collectHsBindBinders mbinds'
301 ok_sig = okInstDclSig (mkNameSet binders)
303 bindLocalNames binders (renameSigs ok_sig uprags) `thenM` \ uprags' ->
305 returnM (InstDecl inst_ty' mbinds' uprags',
306 meth_fvs `plusFV` hsSigsFVs uprags'
307 `plusFV` extractHsTyNames inst_ty')
310 For the method bindings in class and instance decls, we extend the
311 type variable environment iff -fglasgow-exts
314 extendTyVarEnvForMethodBinds tyvars thing_inside
315 = doptM Opt_GlasgowExts `thenM` \ opt_GlasgowExts ->
316 if opt_GlasgowExts then
317 extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
323 %*********************************************************
327 %*********************************************************
330 rnHsRuleDecl (HsRule rule_name act vars lhs fv_lhs rhs fv_rhs)
331 = bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
333 bindLocatedLocalsFV doc (map get_var vars) $ \ ids ->
334 mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
336 rnLExpr lhs `thenM` \ (lhs', fv_lhs') ->
337 rnLExpr rhs `thenM` \ (rhs', fv_rhs') ->
339 mb_bad = validRuleLhs ids lhs'
341 checkErr (isNothing mb_bad)
342 (badRuleLhsErr rule_name lhs' mb_bad) `thenM_`
344 bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
346 mappM (addErr . badRuleVar rule_name) bad_vars `thenM_`
347 returnM (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
348 fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs')
350 doc = text "In the transformation rule" <+> ftext rule_name
352 get_var (RuleBndr v) = v
353 get_var (RuleBndrSig v _) = v
355 rn_var (RuleBndr (L loc v), id)
356 = returnM (RuleBndr (L loc id), emptyFVs)
357 rn_var (RuleBndrSig (L loc v) t, id)
358 = rnHsTypeFVs doc t `thenM` \ (t', fvs) ->
359 returnM (RuleBndrSig (L loc id) t', fvs)
362 Check the shape of a transformation rule LHS. Currently
363 we only allow LHSs of the form @(f e1 .. en)@, where @f@ is
364 not one of the @forall@'d variables. We also restrict the form of the LHS so
365 that it may be plausibly matched. Basically you only get to write ordinary
366 applications. (E.g. a case expression is not allowed: too elaborate.)
368 NB: if you add new cases here, make sure you add new ones to TcRule.ruleLhsTvs
371 validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
373 -- Just e => Not ok, and e is the offending expression
374 validRuleLhs foralls lhs
377 checkl (L loc e) = check e
379 check (OpApp e1 op _ e2) = checkl op `seqMaybe` checkl_e e1 `seqMaybe` checkl_e e2
380 check (HsApp e1 e2) = checkl e1 `seqMaybe` checkl_e e2
381 check (HsVar v) | v `notElem` foralls = Nothing
382 check other = Just other -- Failure
384 checkl_e (L loc e) = check_e e
386 check_e (HsVar v) = Nothing
387 check_e (HsPar e) = checkl_e e
388 check_e (HsLit e) = Nothing
389 check_e (HsOverLit e) = Nothing
391 check_e (OpApp e1 op _ e2) = checkl_e e1 `seqMaybe` checkl_e op `seqMaybe` checkl_e e2
392 check_e (HsApp e1 e2) = checkl_e e1 `seqMaybe` checkl_e e2
393 check_e (NegApp e _) = checkl_e e
394 check_e (ExplicitList _ es) = checkl_es es
395 check_e (ExplicitTuple es _) = checkl_es es
396 check_e other = Just other -- Fails
398 checkl_es es = foldr (seqMaybe . checkl_e) Nothing es
400 badRuleLhsErr name lhs (Just bad_e)
401 = sep [ptext SLIT("Rule") <+> ftext name <> colon,
402 nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
403 ptext SLIT("in left-hand side:") <+> ppr lhs])]
405 ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
408 = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
409 ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
410 ptext SLIT("does not appear on left hand side")]
414 %*********************************************************
416 \subsection{Type, class and iface sig declarations}
418 %*********************************************************
420 @rnTyDecl@ uses the `global name function' to create a new type
421 declaration in which local names have been replaced by their original
422 names, reporting any unknown names.
424 Renaming type variables is a pain. Because they now contain uniques,
425 it is necessary to pass in an association list which maps a parsed
426 tyvar to its @Name@ representation.
427 In some cases (type signatures of values),
428 it is even necessary to go over the type first
429 in order to get the set of tyvars used by it, make an assoc list,
430 and then go over it again to rename the tyvars!
431 However, we can also do some scoping checks at the same time.
434 rnTyClDecl (ForeignType {tcdLName = name, tcdFoType = fo_type, tcdExtName = ext_name})
435 = lookupLocatedTopBndrRn name `thenM` \ name' ->
436 returnM (ForeignType {tcdLName = name', tcdFoType = fo_type, tcdExtName = ext_name},
439 rnTyClDecl (TyData {tcdND = new_or_data, tcdCtxt = context, tcdLName = tycon,
440 tcdTyVars = tyvars, tcdCons = condecls,
441 tcdKindSig = sig, tcdDerivs = derivs})
442 | is_vanilla -- Normal Haskell data type decl
443 = ASSERT( isNothing sig ) -- In normal H98 form, kind signature on the
444 -- data type is syntactically illegal
445 bindTyVarsRn data_doc tyvars $ \ tyvars' ->
446 do { tycon' <- lookupLocatedTopBndrRn tycon
447 ; context' <- rnContext data_doc context
448 ; (derivs', deriv_fvs) <- rn_derivs derivs
449 ; checkDupNames data_doc con_names
450 ; condecls' <- rnConDecls (unLoc tycon') condecls
451 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = context', tcdLName = tycon',
452 tcdTyVars = tyvars', tcdKindSig = Nothing, tcdCons = condecls',
453 tcdDerivs = derivs'},
454 delFVs (map hsLTyVarName tyvars') $
455 extractHsCtxtTyNames context' `plusFV`
456 plusFVs (map conDeclFVs condecls') `plusFV`
460 = do { tycon' <- lookupLocatedTopBndrRn tycon
461 ; checkTc (null (unLoc context)) (badGadtStupidTheta tycon)
462 ; tyvars' <- bindTyVarsRn data_doc tyvars
463 (\ tyvars' -> return tyvars')
464 -- For GADTs, the type variables in the declaration
465 -- do not scope over the constructor signatures
466 -- data T a where { T1 :: forall b. b-> b }
467 ; (derivs', deriv_fvs) <- rn_derivs derivs
468 ; checkDupNames data_doc con_names
469 ; condecls' <- rnConDecls (unLoc tycon') condecls
470 ; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [], tcdLName = tycon',
471 tcdTyVars = tyvars', tcdCons = condecls', tcdKindSig = sig,
472 tcdDerivs = derivs'},
473 plusFVs (map conDeclFVs condecls') `plusFV` deriv_fvs) }
476 is_vanilla = case condecls of -- Yuk
478 L _ (ConDecl { con_res = ResTyH98 }) : _ -> True
481 data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
482 con_names = map con_names_helper condecls
484 con_names_helper (L _ c) = con_name c
486 rn_derivs Nothing = returnM (Nothing, emptyFVs)
487 rn_derivs (Just ds) = rnLHsTypes data_doc ds `thenM` \ ds' ->
488 returnM (Just ds', extractHsTyNames_s ds')
490 rnTyClDecl (TySynonym {tcdLName = name, tcdTyVars = tyvars, tcdSynRhs = ty})
491 = lookupLocatedTopBndrRn name `thenM` \ name' ->
492 bindTyVarsRn syn_doc tyvars $ \ tyvars' ->
493 rnHsTypeFVs syn_doc ty `thenM` \ (ty', fvs) ->
494 returnM (TySynonym {tcdLName = name', tcdTyVars = tyvars',
496 delFVs (map hsLTyVarName tyvars') fvs)
498 syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
500 rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname,
501 tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
503 = lookupLocatedTopBndrRn cname `thenM` \ cname' ->
505 -- Tyvars scope over superclass context and method signatures
506 bindTyVarsRn cls_doc tyvars ( \ tyvars' ->
507 rnContext cls_doc context `thenM` \ context' ->
508 rnFds cls_doc fds `thenM` \ fds' ->
509 renameSigs okClsDclSig sigs `thenM` \ sigs' ->
510 returnM (tyvars', context', fds', sigs')
511 ) `thenM` \ (tyvars', context', fds', sigs') ->
513 -- Check the signatures
514 -- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
516 sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
518 checkDupNames sig_doc sig_rdr_names_w_locs `thenM_`
519 -- Typechecker is responsible for checking that we only
520 -- give default-method bindings for things in this class.
521 -- The renamer *could* check this for class decls, but can't
522 -- for instance decls.
524 -- The newLocals call is tiresome: given a generic class decl
527 -- op {| x+y |} (Inl a) = ...
528 -- op {| x+y |} (Inr b) = ...
529 -- op {| a*b |} (a*b) = ...
530 -- we want to name both "x" tyvars with the same unique, so that they are
531 -- easy to group together in the typechecker.
532 extendTyVarEnvForMethodBinds tyvars' (
533 getLocalRdrEnv `thenM` \ name_env ->
535 meth_rdr_names_w_locs = collectHsBindLocatedBinders mbinds
536 gen_rdr_tyvars_w_locs =
537 [ tv | tv <- extractGenericPatTyVars mbinds,
538 not (unLoc tv `elemLocalRdrEnv` name_env) ]
540 checkDupNames meth_doc meth_rdr_names_w_locs `thenM_`
541 newLocalsRn gen_rdr_tyvars_w_locs `thenM` \ gen_tyvars ->
542 rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds
543 ) `thenM` \ (mbinds', meth_fvs) ->
545 returnM (ClassDecl { tcdCtxt = context', tcdLName = cname', tcdTyVars = tyvars',
546 tcdFDs = fds', tcdSigs = sigs', tcdMeths = mbinds'},
547 delFVs (map hsLTyVarName tyvars') $
548 extractHsCtxtTyNames context' `plusFV`
549 plusFVs (map extractFunDepNames (map unLoc fds')) `plusFV`
550 hsSigsFVs sigs' `plusFV`
553 meth_doc = text "In the default-methods for class" <+> ppr cname
554 cls_doc = text "In the declaration for class" <+> ppr cname
555 sig_doc = text "In the signatures for class" <+> ppr cname
557 badGadtStupidTheta tycon
558 = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
559 ptext SLIT("(You can put a context on each contructor, though.)")]
562 %*********************************************************
564 \subsection{Support code for type/data declarations}
566 %*********************************************************
569 rnConDecls :: Name -> [LConDecl RdrName] -> RnM [LConDecl Name]
570 rnConDecls tycon condecls
571 = mappM (wrapLocM rnConDecl) condecls
573 rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
574 rnConDecl (ConDecl name expl tvs cxt details res_ty)
575 = do { addLocM checkConName name
577 ; new_name <- lookupLocatedTopBndrRn name
578 ; name_env <- getLocalRdrEnv
580 -- For H98 syntax, the tvs are the existential ones
581 -- For GADT syntax, the tvs are all the quantified tyvars
582 -- Hence the 'filter' in the ResTyH98 case only
583 ; let not_in_scope = not . (`elemLocalRdrEnv` name_env) . unLoc
584 arg_tys = hsConArgs details
585 implicit_tvs = case res_ty of
586 ResTyH98 -> filter not_in_scope $
588 ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
591 Implicit -> userHsTyVarBndrs implicit_tvs
593 ; bindTyVarsRn doc tvs' $ \new_tyvars -> do
594 { new_context <- rnContext doc cxt
595 ; new_details <- rnConDetails doc details
596 ; new_res_ty <- rnConResult doc res_ty
597 ; let rv = ConDecl new_name expl new_tyvars new_context new_details new_res_ty
598 ; traceRn (text "****** - autrijus" <> ppr rv)
601 doc = text "In the definition of data constructor" <+> quotes (ppr name)
602 get_rdr_tvs tys = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))
604 rnConResult _ ResTyH98 = return ResTyH98
605 rnConResult doc (ResTyGADT ty) = do
606 ty' <- rnHsSigType doc ty
607 return $ ResTyGADT ty'
609 rnConDetails doc (PrefixCon tys)
610 = mappM (rnLHsType doc) tys `thenM` \ new_tys ->
611 returnM (PrefixCon new_tys)
613 rnConDetails doc (InfixCon ty1 ty2)
614 = rnLHsType doc ty1 `thenM` \ new_ty1 ->
615 rnLHsType doc ty2 `thenM` \ new_ty2 ->
616 returnM (InfixCon new_ty1 new_ty2)
618 rnConDetails doc (RecCon fields)
619 = checkDupNames doc field_names `thenM_`
620 mappM (rnField doc) fields `thenM` \ new_fields ->
621 returnM (RecCon new_fields)
623 field_names = [fld | (fld, _) <- fields]
625 rnField doc (name, ty)
626 = lookupLocatedTopBndrRn name `thenM` \ new_name ->
627 rnLHsType doc ty `thenM` \ new_ty ->
628 returnM (new_name, new_ty)
630 -- This data decl will parse OK
632 -- treating "a" as the constructor.
633 -- It is really hard to make the parser spot this malformation.
634 -- So the renamer has to check that the constructor is legal
636 -- We can get an operator as the constructor, even in the prefix form:
637 -- data T = :% Int Int
638 -- from interface files, which always print in prefix form
640 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
643 = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
647 %*********************************************************
649 \subsection{Support code to rename types}
651 %*********************************************************
654 rnFds :: SDoc -> [Located (FunDep RdrName)] -> RnM [Located (FunDep Name)]
657 = mappM (wrapLocM rn_fds) fds
660 = rnHsTyVars doc tys1 `thenM` \ tys1' ->
661 rnHsTyVars doc tys2 `thenM` \ tys2' ->
662 returnM (tys1', tys2')
664 rnHsTyVars doc tvs = mappM (rnHsTyvar doc) tvs
665 rnHsTyvar doc tyvar = lookupOccRn tyvar
669 %*********************************************************
673 %*********************************************************
679 h = ...$(thing "f")...
681 The splice can expand into literally anything, so when we do dependency
682 analysis we must assume that it might mention 'f'. So we simply treat
683 all locally-defined names as mentioned by any splice. This is terribly
684 brutal, but I don't see what else to do. For example, it'll mean
685 that every locally-defined thing will appear to be used, so no unused-binding
686 warnings. But if we miss the dependency, then we might typecheck 'h' before 'f',
687 and that will crash the type checker because 'f' isn't in scope.
689 Currently, I'm not treating a splice as also mentioning every import,
690 which is a bit inconsistent -- but there are a lot of them. We might
691 thereby get some bogus unused-import warnings, but we won't crash the
692 type checker. Not very satisfactory really.
695 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
696 rnSplice (HsSplice n expr)
697 = do { checkTH expr "splice"
699 ; [n'] <- newLocalsRn [L loc n]
700 ; (expr', fvs) <- rnLExpr expr
702 -- Ugh! See Note [Splices] above
703 ; lcl_rdr <- getLocalRdrEnv
704 ; gbl_rdr <- getGlobalRdrEnv
705 ; let gbl_names = mkNameSet [gre_name gre | gre <- globalRdrEnvElts gbl_rdr,
707 lcl_names = mkNameSet (occEnvElts lcl_rdr)
709 ; return (HsSplice n' expr', fvs `plusFV` lcl_names `plusFV` gbl_names) }
712 checkTH e what = returnM () -- OK
714 checkTH e what -- Raise an error in a stage-1 compiler
715 = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
716 ptext SLIT("illegal in a stage-1 compiler"),