RnSource.lhs 47.1 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 4 5 6
%
\section[RnSource]{Main pass of renamer}

\begin{code}
7
module RnSource ( 
8
	rnSrcDecls, addTcgDUs, rnTyClDecls, findSplice
9
    ) where
10

11
#include "HsVersions.h"
sof's avatar
sof committed
12

13
import {-# SOURCE #-} RnExpr( rnLExpr )
14 15 16
#ifdef GHCI
import {-# SOURCE #-} TcSplice ( runQuasiQuoteDecl )
#endif 	/* GHCI */
17

18
import HsSyn
19
import RdrName		( RdrName, isRdrDataCon, elemLocalRdrEnv, rdrNameOcc )
dreixel's avatar
dreixel committed
20
import RdrHsSyn		( extractHsRhoRdrTyVars )
21
import RnHsSyn
22
import RnTypes		( rnLHsType, rnLHsTypes, rnHsSigType, rnHsTypeFVs, rnContext, rnConDeclFields )
23 24
import RnBinds		( rnTopBindsLHS, rnTopBindsRHS, rnMethodBinds, renameSigs, mkSigTvFn,
                                makeMiniFixityEnv)
25 26
import RnEnv		( lookupLocalDataTcNames, lookupLocatedOccRn,
			  lookupTopBndrRn, lookupLocatedTopBndrRn,
dreixel's avatar
dreixel committed
27
			  lookupOccRn, bindLocalNamesFV,
28
			  bindLocatedLocalsFV, bindPatSigTyVarsFV,
29
			  bindTyVarsRn, bindTyVarsFV, extendTyVarEnvFVRn,
30
			  bindLocalNames, checkDupRdrNames, mapFvRn
31
			)
32
import RnNames       	( getLocalNonValBinders, extendGlobalRdrEnvRn )
33
import HscTypes      	( GenAvailInfo(..), availsToNameSet )
34
import RnHsDoc          ( rnHsDoc, rnMbLHsDoc )
35
import TcRnMonad
36

37 38
import ForeignCall	( CCallTarget(..) )
import Module
Ian Lynagh's avatar
Ian Lynagh committed
39
import HscTypes		( Warnings(..), plusWarns )
40
import Class		( FunDep )
41
import Name		( Name, nameOccName )
42
import NameSet
43
import NameEnv
44
import Outputable
Ian Lynagh's avatar
Ian Lynagh committed
45
import Bag
46
import FastString
47
import Util		( filterOut )
48
import SrcLoc
49
import DynFlags
50
import HscTypes		( HscEnv, hsc_dflags )
51
import BasicTypes       ( Boxity(..) )
52
import ListSetOps       ( findDupsEq )
53
import Digraph		( SCC, flattenSCC, stronglyConnCompFromEdgedVertices )
54

55
import Control.Monad
56
import Maybes( orElse )
Ian Lynagh's avatar
Ian Lynagh committed
57
import Data.Maybe
58 59
\end{code}

Ian Lynagh's avatar
Ian Lynagh committed
60 61 62 63 64 65 66 67 68
\begin{code}
-- XXX
thenM :: Monad a => a b -> (b -> a c) -> a c
thenM = (>>=)

thenM_ :: Monad a => a b -> a c -> a c
thenM_ = (>>)
\end{code}

69
@rnSourceDecl@ `renames' declarations.
70 71 72 73 74 75
It simultaneously performs dependency analysis and precedence parsing.
It also does the following error checks:
\begin{enumerate}
\item
Checks that tyvars are used properly. This includes checking
for undefined tyvars, and tyvars in contexts that are ambiguous.
76 77
(Some of this checking has now been moved to module @TcMonoType@,
since we don't have functional dependency information at this point.)
78 79 80
\item
Checks that all variable occurences are defined.
\item 
81
Checks the @(..)@ etc constraints in the export list.
82 83 84
\end{enumerate}


85
\begin{code}
86
-- Brings the binders of the group into scope in the appropriate places;
87
-- does NOT assume that anything is in scope already
88
rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
89
-- Rename a HsGroup; used for normal source files *and* hs-boot files
90 91 92 93 94 95 96 97 98 99
rnSrcDecls group@(HsGroup { hs_valds   = val_decls,
                            hs_tyclds  = tycl_decls,
                            hs_instds  = inst_decls,
                            hs_derivds = deriv_decls,
                            hs_fixds   = fix_decls,
                            hs_warnds  = warn_decls,
                            hs_annds   = ann_decls,
                            hs_fords   = foreign_decls,
                            hs_defds   = default_decls,
                            hs_ruleds  = rule_decls,
100
                            hs_vects   = vect_decls,
101
                            hs_docs    = docs })
102 103 104 105 106 107 108
 = do {
   -- (A) Process the fixity declarations, creating a mapping from
   --     FastStrings to FixItems.
   --     Also checks for duplcates.
   local_fix_env <- makeMiniFixityEnv fix_decls;

   -- (B) Bring top level binders (and their fixities) into scope,
109
   --     *except* for the value bindings, which get brought in below.
110 111 112 113
   --     However *do* include class ops, data constructors
   --     And for hs-boot files *do* include the value signatures
   tc_avails <- getLocalNonValBinders group ;
   tc_envs <- extendGlobalRdrEnvRn tc_avails local_fix_env ;
114
   setEnvs tc_envs $ do {
115 116 117 118 119 120 121

   failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations

   -- (C) Extract the mapping from data constructors to field names and
   --     extend the record field env.
   --     This depends on the data constructors and field names being in
   --     scope from (B) above
122
   inNewEnv (extendRecordFieldEnv tycl_decls inst_decls) $ \ _ -> do {
123 124 125 126 127 128 129

   -- (D) Rename the left-hand sides of the value bindings.
   --     This depends on everything from (B) being in scope,
   --     and on (C) for resolving record wild cards.
   --     It uses the fixity env from (A) to bind fixities for view patterns.
   new_lhs <- rnTopBindsLHS local_fix_env val_decls ;
   -- bind the LHSes (and their fixities) in the global rdr environment
130
   let { val_binders = collectHsValBinders new_lhs ;
131 132 133
	 val_bndr_set = mkNameSet val_binders ;
	 all_bndr_set = val_bndr_set `unionNameSets` availsToNameSet tc_avails ;
         val_avails = map Avail val_binders 
134
       } ;
135
   (tcg_env, tcl_env) <- extendGlobalRdrEnvRn val_avails local_fix_env ;
136
   setEnvs (tcg_env, tcl_env) $ do {
137 138 139 140 141 142 143 144 145 146 147 148 149 150

   --  Now everything is in scope, as the remaining renaming assumes.

   -- (E) Rename type and class decls
   --     (note that value LHSes need to be in scope for default methods)
   --
   -- You might think that we could build proper def/use information
   -- for type and class declarations, but they can be involved
   -- in mutual recursion across modules, and we only do the SCC
   -- analysis for them in the type checker.
   -- So we content ourselves with gathering uses only; that
   -- means we'll only report a declaration as unused if it isn't
   -- mentioned at all.  Ah well.
   traceRn (text "Start rnTyClDecls") ;
151
   (rn_tycl_decls, src_fvs1) <- rnTyClDecls tycl_decls ;
152 153 154

   -- (F) Rename Value declarations right-hand sides
   traceRn (text "Start rnmono") ;
155
   (rn_val_decls, bind_dus) <- rnTopBindsRHS new_lhs ;
156 157 158 159
   traceRn (text "finish rnmono" <+> ppr rn_val_decls) ;

   -- (G) Rename Fixity and deprecations
   
160
   -- Rename fixity declarations and error if we try to
161
   -- fix something from another module (duplicates were checked in (A))
162 163 164
   rn_fix_decls <- rnSrcFixityDecls all_bndr_set fix_decls ;

   -- Rename deprec decls;
165 166
   -- check for duplicates and ensure that deprecated things are defined locally
   -- at the moment, we don't keep these around past renaming
167
   rn_warns <- rnSrcWarnDecls all_bndr_set warn_decls ;
168 169 170 171

   -- (H) Rename Everything else

   (rn_inst_decls,    src_fvs2) <- rnList rnSrcInstDecl   inst_decls ;
172
   (rn_rule_decls,    src_fvs3) <- setOptM Opt_ScopedTypeVariables $
173 174 175 176 177 178 179
                                   rnList rnHsRuleDecl    rule_decls ;
                           -- Inside RULES, scoped type variables are on
   (rn_vect_decls,    src_fvs4) <- rnList rnHsVectDecl    vect_decls ;
   (rn_foreign_decls, src_fvs5) <- rnList rnHsForeignDecl foreign_decls ;
   (rn_ann_decls,     src_fvs6) <- rnList rnAnnDecl       ann_decls ;
   (rn_default_decls, src_fvs7) <- rnList rnDefaultDecl   default_decls ;
   (rn_deriv_decls,   src_fvs8) <- rnList rnSrcDerivDecl  deriv_decls ;
180 181 182 183
      -- Haddock docs; no free vars
   rn_docs <- mapM (wrapLocM rnDocDecl) docs ;

   -- (I) Compute the results and return
184 185 186
   let {rn_group = HsGroup { hs_valds  	= rn_val_decls,
			     hs_tyclds 	= rn_tycl_decls,
			     hs_instds 	= rn_inst_decls,
187
                             hs_derivds = rn_deriv_decls,
188 189
			     hs_fixds   = rn_fix_decls,
			     hs_warnds  = [], -- warns are returned in the tcg_env
190 191
	                                     -- (see below) not in the HsGroup
			     hs_fords  = rn_foreign_decls,
192
			     hs_annds  = rn_ann_decls,
193 194
			     hs_defds  = rn_default_decls,
			     hs_ruleds = rn_rule_decls,
195
			     hs_vects  = rn_vect_decls,
196
                             hs_docs   = rn_docs } ;
197

198 199 200 201
        tycl_bndrs = hsTyClDeclsBinders rn_tycl_decls rn_inst_decls ;
        ford_bndrs = hsForeignDeclsBinders rn_foreign_decls ;
	other_def  = (Just (mkNameSet tycl_bndrs `unionNameSets` mkNameSet ford_bndrs), emptyNameSet) ;
        other_fvs  = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4, 
202
			      src_fvs5, src_fvs6, src_fvs7, src_fvs8] ;
203 204 205 206 207 208 209 210 211
		-- It is tiresome to gather the binders from type and class decls

	src_dus = [other_def] `plusDU` bind_dus `plusDU` usesOnly other_fvs ;
		-- Instance decls may have occurrences of things bound in bind_dus
		-- so we must put other_fvs last

        final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus)
                        in -- we return the deprecs in the env, not in the HsGroup above
                        tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns };
212 213 214 215
       } ;

   traceRn (text "finish rnSrc" <+> ppr rn_group) ;
   traceRn (text "finish Dus" <+> ppr src_dus ) ;
216
   return (final_tcg_env, rn_group)
217 218 219 220 221 222 223
                    }}}}

-- some utils because we do this a bunch above
-- compute and install the new env
inNewEnv :: TcM TcGblEnv -> (TcGblEnv -> TcM a) -> TcM a
inNewEnv env cont = do e <- env
                       setGblEnv e $ cont e
224

225
addTcgDUs :: TcGblEnv -> DefUses -> TcGblEnv 
226 227
-- This function could be defined lower down in the module hierarchy, 
-- but there doesn't seem anywhere very logical to put it.
228
addTcgDUs tcg_env dus = tcg_env { tcg_dus = tcg_dus tcg_env `plusDU` dus }
229 230 231

rnList :: (a -> RnM (b, FreeVars)) -> [Located a] -> RnM ([Located b], FreeVars)
rnList f xs = mapFvRn (wrapLocFstM f) xs
232 233 234 235 236 237 238 239 240 241
\end{code}


%*********************************************************
%*						 	 *
	HsDoc stuff
%*							 *
%*********************************************************

\begin{code}
242
rnDocDecl :: DocDecl -> RnM DocDecl
243 244 245 246 247 248 249 250 251 252 253 254
rnDocDecl (DocCommentNext doc) = do 
  rn_doc <- rnHsDoc doc
  return (DocCommentNext rn_doc)
rnDocDecl (DocCommentPrev doc) = do 
  rn_doc <- rnHsDoc doc
  return (DocCommentPrev rn_doc)
rnDocDecl (DocCommentNamed str doc) = do
  rn_doc <- rnHsDoc doc
  return (DocCommentNamed str rn_doc)
rnDocDecl (DocGroup lev doc) = do
  rn_doc <- rnHsDoc doc
  return (DocGroup lev rn_doc)
255 256 257 258 259 260 261 262 263 264
\end{code}


%*********************************************************
%*						 	 *
	Source-code fixity declarations
%*							 *
%*********************************************************

\begin{code}
265
rnSrcFixityDecls :: NameSet -> [LFixitySig RdrName] -> RnM [LFixitySig Name]
266 267 268
-- Rename the fixity decls, so we can put
-- the renamed decls in the renamed syntax tree
-- Errors if the thing being fixed is not defined locally.
269 270 271
--
-- The returned FixitySigs are not actually used for anything,
-- except perhaps the GHCi API
272
rnSrcFixityDecls bound_names fix_decls
273 274 275 276
  = do fix_decls <- mapM rn_decl fix_decls
       return (concat fix_decls)
  where
    rn_decl :: LFixitySig RdrName -> RnM [LFixitySig Name]
277
        -- GHC extension: look up both the tycon and data con 
278
	-- for con-like things; hence returning a list
279
	-- If neither are in scope, report an error; otherwise
280
	-- return a fixity sig for each (slightly odd)
281 282
    rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
      = setSrcSpan name_loc $
283
                    -- this lookup will fail if the definition isn't local
284
        do names <- lookupLocalDataTcNames bound_names what rdr_name
285
           return [ L loc (FixitySig (L name_loc name) fixity)
286 287
                  | name <- names ]
    what = ptext (sLit "fixity signature")
288 289 290 291 292 293 294 295 296
\end{code}


%*********************************************************
%*						 	 *
	Source-code deprecations declarations
%*							 *
%*********************************************************

297 298 299
Check that the deprecated names are defined, are defined locally, and
that there are no duplicate deprecations.

300 301 302 303
It's only imported deprecations, dealt with in RnIfaces, that we
gather them together.

\begin{code}
304
-- checks that the deprecations are defined locally, and that there are no duplicates
305 306
rnSrcWarnDecls :: NameSet -> [LWarnDecl RdrName] -> RnM Warnings
rnSrcWarnDecls _bound_names [] 
307
  = return NoWarnings
308

309
rnSrcWarnDecls bound_names decls 
310
  = do { -- check for duplicates
311 312
       ; mapM_ (\ dups -> let (L loc rdr:lrdr':_) = dups
                          in addErrAt loc (dupWarnDecl lrdr' rdr)) 
313 314 315
               warn_rdr_dups
       ; pairs_s <- mapM (addLocM rn_deprec) decls
       ; return (WarnSome ((concat pairs_s))) }
316
 where
Ian Lynagh's avatar
Ian Lynagh committed
317
   rn_deprec (Warning rdr_name txt)
318
       -- ensures that the names are defined locally
319
     = lookupLocalDataTcNames bound_names what rdr_name	`thenM` \ names ->
320
       return [(nameOccName name, txt) | name <- names]
321
   
322 323
   what = ptext (sLit "deprecation")

324 325 326
   -- look for duplicates among the OccNames;
   -- we check that the names are defined above
   -- invt: the lists returned by findDupsEq always have at least two elements
Ian Lynagh's avatar
Ian Lynagh committed
327 328
   warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
                     (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls)
329
               
Ian Lynagh's avatar
Ian Lynagh committed
330
dupWarnDecl :: Located RdrName -> RdrName -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
331
-- Located RdrName -> DeprecDecl RdrName -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
332 333
dupWarnDecl (L loc _) rdr_name
  = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name),
Ian Lynagh's avatar
Ian Lynagh committed
334
          ptext (sLit "also at ") <+> ppr loc]
335

336
\end{code}
337

338 339
%*********************************************************
%*							*
340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359
\subsection{Annotation declarations}
%*							*
%*********************************************************

\begin{code}
rnAnnDecl :: AnnDecl RdrName -> RnM (AnnDecl Name, FreeVars)
rnAnnDecl (HsAnnotation provenance expr) = do
    (provenance', provenance_fvs) <- rnAnnProvenance provenance
    (expr', expr_fvs) <- rnLExpr expr
    return (HsAnnotation provenance' expr', provenance_fvs `plusFV` expr_fvs)

rnAnnProvenance :: AnnProvenance RdrName -> RnM (AnnProvenance Name, FreeVars)
rnAnnProvenance provenance = do
    provenance' <- modifyAnnProvenanceNameM lookupTopBndrRn provenance
    return (provenance', maybe emptyFVs unitFV (annProvenanceName_maybe provenance'))
\end{code}

%*********************************************************
%*							*
\subsection{Default declarations}
360 361
%*							*
%*********************************************************
362

363
\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
364
rnDefaultDecl :: DefaultDecl RdrName -> RnM (DefaultDecl Name, FreeVars)
365 366
rnDefaultDecl (DefaultDecl tys)
  = mapFvRn (rnHsTypeFVs doc_str) tys	`thenM` \ (tys', fvs) ->
367
    return (DefaultDecl tys', fvs)
368
  where
369
    doc_str = text "In a `default' declaration"
370 371
\end{code}

372 373 374 375 376 377 378
%*********************************************************
%*							*
\subsection{Foreign declarations}
%*							*
%*********************************************************

\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
379
rnHsForeignDecl :: ForeignDecl RdrName -> RnM (ForeignDecl Name, FreeVars)
Simon Marlow's avatar
Simon Marlow committed
380
rnHsForeignDecl (ForeignImport name ty spec)
381 382
  = getTopEnv                           `thenM` \ (topEnv :: HscEnv) ->
    lookupLocatedTopBndrRn name	        `thenM` \ name' ->
383
    rnHsTypeFVs (fo_decl_msg name) ty	`thenM` \ (ty', fvs) ->
384 385 386 387 388 389

    -- Mark any PackageTarget style imports as coming from the current package
    let packageId	= thisPackage $ hsc_dflags topEnv
	spec'		= patchForeignImport packageId spec

    in	return (ForeignImport name' ty' spec', fvs)
390

Simon Marlow's avatar
Simon Marlow committed
391
rnHsForeignDecl (ForeignExport name ty spec)
392
  = lookupLocatedOccRn name	        `thenM` \ name' ->
393
    rnHsTypeFVs (fo_decl_msg name) ty  	`thenM` \ (ty', fvs) ->
394
    return (ForeignExport name' ty' spec, fvs `addOneFV` unLoc name')
395 396 397
	-- NB: a foreign export is an *occurrence site* for name, so 
	--     we add it to the free-variable list.  It might, for example,
	--     be imported from another module
398

Ian Lynagh's avatar
Ian Lynagh committed
399
fo_decl_msg :: Located RdrName -> SDoc
Ian Lynagh's avatar
Ian Lynagh committed
400
fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420


-- | For Windows DLLs we need to know what packages imported symbols are from
--	to generate correct calls. Imported symbols are tagged with the current
--	package, so if they get inlined across a package boundry we'll still
--	know where they're from.
--
patchForeignImport :: PackageId -> ForeignImport -> ForeignImport
patchForeignImport packageId (CImport cconv safety fs spec)
	= CImport cconv safety fs (patchCImportSpec packageId spec) 

patchCImportSpec :: PackageId -> CImportSpec -> CImportSpec
patchCImportSpec packageId spec
 = case spec of
	CFunction callTarget	-> CFunction $ patchCCallTarget packageId callTarget
	_			-> spec

patchCCallTarget :: PackageId -> CCallTarget -> CCallTarget
patchCCallTarget packageId callTarget
 = case callTarget of
421 422
 	StaticTarget label Nothing
	 -> StaticTarget label (Just packageId)
423 424 425 426

	_			-> callTarget	


427 428 429 430 431 432 433 434 435 436
\end{code}


%*********************************************************
%*							*
\subsection{Instance declarations}
%*							*
%*********************************************************

\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
437
rnSrcInstDecl :: InstDecl RdrName -> RnM (InstDecl Name, FreeVars)
438
rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
439
	-- Used for both source and interface file decls
440
  = rnHsSigType (text "an instance decl") inst_ty	`thenM` \ inst_ty' ->
441

442 443 444
	-- Rename the bindings
	-- The typechecker (not the renamer) checks that all 
	-- the bindings are for the right class
445
    let
446
	(inst_tyvars, _, cls,_) = splitHsInstDeclTy (unLoc inst_ty')
447
    in
448
    extendTyVarEnvForMethodBinds inst_tyvars (		
449 450
	-- (Slightly strangely) the forall-d tyvars scope over
	-- the method bindings too
Ian Lynagh's avatar
Ian Lynagh committed
451
	rnMethodBinds cls (\_ -> []) 	-- No scoped tyvars
dreixel's avatar
dreixel committed
452
		      mbinds
453
    )						`thenM` \ (mbinds', meth_fvs) ->
454 455 456 457
	-- Rename the associated types
	-- The typechecker (not the renamer) checks that all 
	-- the declarations are for the right class
    let
458
	at_names = map (head . hsTyClDeclBinders) ats
459
    in
460
    checkDupRdrNames at_names		`thenM_`
461 462 463 464
	-- See notes with checkDupRdrNames for methods, above

    rnATInsts ats				`thenM` \ (ats', at_fvs) ->

465 466 467 468 469 470 471
	-- Rename the prags and signatures.
	-- Note that the type variables are not in scope here,
	-- so that	instance Eq a => Eq (T a) where
	--			{-# SPECIALISE instance Eq a => Eq (T [a]) #-}
	-- works OK. 
	--
	-- But the (unqualified) method names are in scope
472
    let 
473
	binders = collectHsBindsBinders mbinds'
474
	bndr_set = mkNameSet binders
475
    in
476 477
    bindLocalNames binders 
	(renameSigs (Just bndr_set) okInstDclSig uprags)	`thenM` \ uprags' ->
478

479
    return (InstDecl inst_ty' mbinds' uprags' ats',
480 481
	     meth_fvs `plusFV` at_fvs
		      `plusFV` hsSigsFVs uprags'
482
		      `plusFV` extractHsTyNames inst_ty')
483 484 485 486 487 488 489 490 491 492 493 494
             -- We return the renamed associated data type declarations so
             -- that they can be entered into the list of type declarations
             -- for the binding group, but we also keep a copy in the instance.
             -- The latter is needed for well-formedness checks in the type
             -- checker (eg, to ensure that all ATs of the instance actually
             -- receive a declaration). 
	     -- NB: Even the copies in the instance declaration carry copies of
	     --     the instance context after renaming.  This is a bit
	     --     strange, but should not matter (and it would be more work
	     --     to remove the context).
\end{code}

495
Renaming of the associated types in instances.  
496

497
\begin{code}
498
rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
499
rnATInsts atDecls = rnList rnATInst atDecls
500
  where
501
    rnATInst tydecl@TyData     {} = rnTyClDecl tydecl
502
    rnATInst tydecl@TySynonym  {} = rnTyClDecl tydecl
503 504 505
    rnATInst tydecl               =
      pprPanic "RnSource.rnATInsts: invalid AT instance" 
	       (ppr (tcdName tydecl))
506 507
\end{code}

508 509 510 511
For the method bindings in class and instance decls, we extend the 
type variable environment iff -fglasgow-exts

\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
512 513 514
extendTyVarEnvForMethodBinds :: [LHsTyVarBndr Name]
                             -> RnM (Bag (LHsBind Name), FreeVars)
                             -> RnM (Bag (LHsBind Name), FreeVars)
515
extendTyVarEnvForMethodBinds tyvars thing_inside
516
  = do	{ scoped_tvs <- xoptM Opt_ScopedTypeVariables
517 518 519 520
	; if scoped_tvs then
		extendTyVarEnvFVRn (map hsLTyVarName tyvars) thing_inside
	  else
		thing_inside }
521 522
\end{code}

523 524 525 526 527 528 529 530
%*********************************************************
%*							*
\subsection{Stand-alone deriving declarations}
%*							*
%*********************************************************

\begin{code}
rnSrcDerivDecl :: DerivDecl RdrName -> RnM (DerivDecl Name, FreeVars)
531
rnSrcDerivDecl (DerivDecl ty)
532
  = do { standalone_deriv_ok <- xoptM Opt_StandaloneDeriving
533 534 535 536 537 538 539 540 541
       ; unless standalone_deriv_ok (addErr standaloneDerivErr)
       ; ty' <- rnLHsType (text "a deriving decl") ty
       ; let fvs = extractHsTyNames ty'
       ; return (DerivDecl ty', fvs) }

standaloneDerivErr :: SDoc
standaloneDerivErr 
  = hang (ptext (sLit "Illegal standalone deriving declaration"))
       2 (ptext (sLit "Use -XStandaloneDeriving to enable this extension"))
542
\end{code}
543

544 545 546 547 548 549 550
%*********************************************************
%*							*
\subsection{Rules}
%*							*
%*********************************************************

\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
551 552
rnHsRuleDecl :: RuleDecl RdrName -> RnM (RuleDecl Name, FreeVars)
rnHsRuleDecl (HsRule rule_name act vars lhs _fv_lhs rhs _fv_rhs)
553
  = bindPatSigTyVarsFV (collectRuleBndrSigTys vars)	$
554
    bindLocatedLocalsFV (map get_var vars)		$ \ ids ->
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
555 556 557
    do	{ (vars', fv_vars) <- mapFvRn rn_var (vars `zip` ids)
		-- NB: The binders in a rule are always Ids
		--     We don't (yet) support type variables
558

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
559 560
	; (lhs', fv_lhs') <- rnLExpr lhs
	; (rhs', fv_rhs') <- rnLExpr rhs
561

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
562
	; checkValidRule rule_name ids lhs' fv_lhs'
563

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
564 565
	; return (HsRule rule_name act vars' lhs' fv_lhs' rhs' fv_rhs',
		  fv_vars `plusFV` fv_lhs' `plusFV` fv_rhs') }
566
  where
567
    doc = text "In the transformation rule" <+> ftext rule_name
568 569 570 571
  
    get_var (RuleBndr v)      = v
    get_var (RuleBndrSig v _) = v

Ian Lynagh's avatar
Ian Lynagh committed
572
    rn_var (RuleBndr (L loc _), id)
573
	= return (RuleBndr (L loc id), emptyFVs)
Ian Lynagh's avatar
Ian Lynagh committed
574
    rn_var (RuleBndrSig (L loc _) t, id)
575
	= rnHsTypeFVs doc t	`thenM` \ (t', fvs) ->
576
	  return (RuleBndrSig (L loc id) t', fvs)
577

Ian Lynagh's avatar
Ian Lynagh committed
578
badRuleVar :: FastString -> Name -> SDoc
579
badRuleVar name var
Ian Lynagh's avatar
Ian Lynagh committed
580 581 582
  = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
	 ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+> 
		ptext (sLit "does not appear on left hand side")]
583 584
\end{code}

585 586 587 588 589
Note [Rule LHS validity checking]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Check the shape of a transformation rule LHS.  Currently we only allow
LHSs of the form @(f e1 .. en)@, where @f@ is not one of the
@forall@'d variables.  
590

591 592 593
We used restrict the form of the 'ei' to prevent you writing rules
with LHSs with a complicated desugaring (and hence unlikely to match);
(e.g. a case expression is not allowed: too elaborate.)
594

595 596 597 598
But there are legitimate non-trivial args ei, like sections and
lambdas.  So it seems simmpler not to check at all, and that is why
check_e is commented out.
	
599
\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
600
checkValidRule :: FastString -> [Name] -> LHsExpr Name -> NameSet -> RnM ()
601 602 603 604 605 606 607 608
checkValidRule rule_name ids lhs' fv_lhs'
  = do 	{ 	-- Check for the form of the LHS
	  case (validRuleLhs ids lhs') of
		Nothing  -> return ()
		Just bad -> failWithTc (badRuleLhsErr rule_name lhs' bad)

		-- Check that LHS vars are all bound
	; let bad_vars = [var | var <- ids, not (var `elemNameSet` fv_lhs')]
Ian Lynagh's avatar
Ian Lynagh committed
609
	; mapM_ (addErr . badRuleVar rule_name) bad_vars }
610

611
validRuleLhs :: [Name] -> LHsExpr Name -> Maybe (HsExpr Name)
612 613
-- Nothing => OK
-- Just e  => Not ok, and e is the offending expression
614
validRuleLhs foralls lhs
615
  = checkl lhs
616
  where
Ian Lynagh's avatar
Ian Lynagh committed
617
    checkl (L _ e) = check e
618

619 620
    check (OpApp e1 op _ e2)		  = checkl op `mplus` checkl_e e1 `mplus` checkl_e e2
    check (HsApp e1 e2) 		  = checkl e1 `mplus` checkl_e e2
621 622 623
    check (HsVar v) | v `notElem` foralls = Nothing
    check other				  = Just other 	-- Failure

624
	-- Check an argument
Ian Lynagh's avatar
Ian Lynagh committed
625
    checkl_e (L _ _e) = Nothing 	-- Was (check_e e); see Note [Rule LHS validity checking]
626

627
{-	Commented out; see Note [Rule LHS validity checking] above 
628
    check_e (HsVar v)     = Nothing
629
    check_e (HsPar e) 	  = checkl_e e
630 631 632
    check_e (HsLit e) 	  = Nothing
    check_e (HsOverLit e) = Nothing

633 634
    check_e (OpApp e1 op _ e2) 	 = checkl_e e1 `mplus` checkl_e op `mplus` checkl_e e2
    check_e (HsApp e1 e2)      	 = checkl_e e1 `mplus` checkl_e e2
635 636
    check_e (NegApp e _)       	 = checkl_e e
    check_e (ExplicitList _ es)	 = checkl_es es
637 638
    check_e other		 = Just other	-- Fails

639
    checkl_es es = foldr (mplus . checkl_e) Nothing es
640
-}
641

Ian Lynagh's avatar
Ian Lynagh committed
642
badRuleLhsErr :: FastString -> LHsExpr Name -> HsExpr Name -> SDoc
643
badRuleLhsErr name lhs bad_e
Ian Lynagh's avatar
Ian Lynagh committed
644 645 646
  = sep [ptext (sLit "Rule") <+> ftext name <> colon,
	 nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e, 
		       ptext (sLit "in left-hand side:") <+> ppr lhs])]
647
    $$
Ian Lynagh's avatar
Ian Lynagh committed
648
    ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
649 650
\end{code}

651

652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668
%*********************************************************
%*                                                      *
\subsection{Vectorisation declarations}
%*                                                      *
%*********************************************************

\begin{code}
rnHsVectDecl :: VectDecl RdrName -> RnM (VectDecl Name, FreeVars)
rnHsVectDecl (HsVect var Nothing)
  = do { var' <- wrapLocM lookupTopBndrRn var
       ; return (HsVect var' Nothing, unitFV (unLoc var'))
       }
rnHsVectDecl (HsVect var (Just rhs))
  = do { var' <- wrapLocM lookupTopBndrRn var
       ; (rhs', fv_rhs) <- rnLExpr rhs
       ; return (HsVect var' (Just rhs'), fv_rhs `addOneFV` unLoc var')
       }
669 670 671 672
rnHsVectDecl (HsNoVect var)
  = do { var' <- wrapLocM lookupTopBndrRn var
       ; return (HsNoVect var', unitFV (unLoc var'))
       }
673 674
\end{code}

675 676
%*********************************************************
%*							*
677
\subsection{Type, class and iface sig declarations}
678 679 680 681 682 683 684 685 686
%*							*
%*********************************************************

@rnTyDecl@ uses the `global name function' to create a new type
declaration in which local names have been replaced by their original
names, reporting any unknown names.

Renaming type variables is a pain. Because they now contain uniques,
it is necessary to pass in an association list which maps a parsed
687 688 689 690 691 692
tyvar to its @Name@ representation.
In some cases (type signatures of values),
it is even necessary to go over the type first
in order to get the set of tyvars used by it, make an assoc list,
and then go over it again to rename the tyvars!
However, we can also do some scoping checks at the same time.
693 694

\begin{code}
695 696 697 698 699 700 701 702 703 704 705 706
rnTyClDecls :: [[LTyClDecl RdrName]] -> RnM ([[LTyClDecl Name]], FreeVars)
-- Renamed the declarations and do depedency analysis on them
rnTyClDecls tycl_ds
  = do { ds_w_fvs <- mapM (wrapLocFstM rnTyClDecl) (concat tycl_ds)

       ; let sccs :: [SCC (LTyClDecl Name)]
             sccs = depAnalTyClDecls ds_w_fvs

             all_fvs = foldr (plusFV . snd) emptyFVs ds_w_fvs

       ; return (map flattenSCC sccs, all_fvs) }

Ian Lynagh's avatar
Ian Lynagh committed
707
rnTyClDecl :: TyClDecl RdrName -> RnM (TyClDecl Name, FreeVars)
708
rnTyClDecl (ForeignType {tcdLName = name, tcdExtName = ext_name})
709
  = lookupLocatedTopBndrRn name		`thenM` \ name' ->
710
    return (ForeignType {tcdLName = name', tcdExtName = ext_name},
711
	     emptyFVs)
712

713 714
-- all flavours of type family declarations ("type family", "newtype fanily",
-- and "data family")
715
rnTyClDecl tydecl@TyFamily {} = rnFamily tydecl bindTyVarsFV
716 717

-- "data", "newtype", "data instance, and "newtype instance" declarations
718
rnTyClDecl tydecl@TyData {tcdND = new_or_data, tcdCtxt = context, 
719
			   tcdLName = tycon, tcdTyVars = tyvars, 
720
			   tcdTyPats = typats, tcdCons = condecls, 
721
			   tcdKindSig = sig, tcdDerivs = derivs}
722
  = do	{ tycon' <- if isFamInstDecl tydecl
723 724
		    then lookupLocatedOccRn     tycon -- may be imported family
		    else lookupLocatedTopBndrRn tycon
725 726
	; checkTc (h98_style || null (unLoc context)) 
                  (badGadtStupidTheta tycon)
727 728
    	; ((tyvars', context', typats', derivs'), stuff_fvs)
		<- bindTyVarsFV tyvars $ \ tyvars' -> do
729
		         	 -- Checks for distinct tyvars
730 731 732 733 734 735
		   { context' <- rnContext data_doc context
                   ; (typats', fvs1) <- rnTyPats data_doc tycon' typats
                   ; (derivs', fvs2) <- rn_derivs derivs
                   ; let fvs = fvs1 `plusFV` fvs2 `plusFV` 
                               extractHsCtxtTyNames context'
		   ; return ((tyvars', context', typats', derivs'), fvs) }
736

737 738
	-- For the constructor declarations, bring into scope the tyvars 
	-- bound by the header, but *only* in the H98 case
739 740 741
	-- Reason: for GADTs, the type variables in the declaration 
	--   do not scope over the constructor signatures
	--   data T a where { T1 :: forall b. b-> b }
742 743 744 745
        ; let tc_tvs_in_scope | h98_style = hsLTyVarNames tyvars'
                              | otherwise = []
	; (condecls', con_fvs) <- bindLocalNamesFV tc_tvs_in_scope $
                                  rnConDecls condecls
746
		-- No need to check for duplicate constructor decls
747
		-- since that is done by RnNames.extendGlobalRdrEnvRn
748

749
	; return (TyData {tcdND = new_or_data, tcdCtxt = context', 
750
			   tcdLName = tycon', tcdTyVars = tyvars', 
751
			   tcdTyPats = typats', tcdKindSig = sig,
752
			   tcdCons = condecls', tcdDerivs = derivs'}, 
753
	     	   con_fvs `plusFV` stuff_fvs)
754
        }
sof's avatar
sof committed
755
  where
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
756 757 758 759
    h98_style = case condecls of	 -- Note [Stupid theta]
		     L _ (ConDecl { con_res = ResTyGADT {} }) : _  -> False
		     _    		                           -> True
               		     						  
760
    data_doc = text "In the data type declaration for" <+> quotes (ppr tycon)
761

762
    rn_derivs Nothing   = return (Nothing, emptyFVs)
763
    rn_derivs (Just ds) = rnLHsTypes data_doc ds	`thenM` \ ds' -> 
764
			  return (Just ds', extractHsTyNames_s ds')
765

766
-- "type" and "type instance" declarations
767
rnTyClDecl tydecl@(TySynonym {tcdLName = name, tcdTyVars = tyvars,
768 769
			      tcdTyPats = typats, tcdSynRhs = ty})
  = bindTyVarsFV tyvars $ \ tyvars' -> do
770 771 772 773
    {    	 -- Checks for distinct tyvars
      name' <- if isFamInstDecl tydecl
    		  then lookupLocatedOccRn     name -- may be imported family
    		  else lookupLocatedTopBndrRn name
774 775
    ; (typats',fvs1) <- rnTyPats syn_doc name' typats
    ; (ty', fvs2)    <- rnHsTypeFVs syn_doc ty
776 777
    ; return (TySynonym { tcdLName = name', tcdTyVars = tyvars' 
    			, tcdTyPats = typats', tcdSynRhs = ty'},
778
    	      fvs1 `plusFV` fvs2) }
sof's avatar
sof committed
779
  where
780
    syn_doc = text "In the declaration for type synonym" <+> quotes (ppr name)
781

782
rnTyClDecl (ClassDecl {tcdCtxt = context, tcdLName = cname, 
783
		       tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs, 
784
		       tcdMeths = mbinds, tcdATs = ats, tcdDocs = docs})
785
  = do	{ cname' <- lookupLocatedTopBndrRn cname
sof's avatar
sof committed
786

787
	-- Tyvars scope over superclass context and method signatures
788 789
	; ((tyvars', context', fds', ats', sigs'), stuff_fvs)
	    <- bindTyVarsFV tyvars $ \ tyvars' -> do
790
         	 -- Checks for distinct tyvars
791 792
	     { context' <- rnContext cls_doc context
	     ; fds' <- rnFds cls_doc fds
793
	     ; (ats', at_fvs) <- rnATs ats
794
	     ; sigs' <- renameSigs Nothing okClsDclSig sigs
795 796 797 798 799
	     ; let fvs = at_fvs `plusFV` 
                         extractHsCtxtTyNames context'	`plusFV`
	                 hsSigsFVs sigs'
			 -- The fundeps have no free variables
	     ; return ((tyvars', context', fds', ats', sigs'), fvs) }
800

801
	-- No need to check for duplicate associated type decls
802
	-- since that is done by RnNames.extendGlobalRdrEnvRn
803

804
	-- Check the signatures
805
	-- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
806
	; let sig_rdr_names_w_locs = [op | L _ (TypeSig op _) <- sigs]
807
	; checkDupRdrNames sig_rdr_names_w_locs
808 809 810 811
		-- Typechecker is responsible for checking that we only
		-- give default-method bindings for things in this class.
		-- The renamer *could* check this for class decls, but can't
		-- for instance decls.
812

813
   	-- The newLocals call is tiresome: given a generic class decl
814 815 816 817 818 819 820
	--	class C a where
	--	  op :: a -> a
	--	  op {| x+y |} (Inl a) = ...
	--	  op {| x+y |} (Inr b) = ...
	--	  op {| a*b |} (a*b)   = ...
	-- we want to name both "x" tyvars with the same unique, so that they are
	-- easy to group together in the typechecker.  
821
	; (mbinds', meth_fvs) 
dreixel's avatar
dreixel committed
822
	    <- extendTyVarEnvForMethodBinds tyvars' $
823
		-- No need to check for duplicate method signatures
824
		-- since that is done by RnNames.extendGlobalRdrEnvRn
825
		-- and the methods are already in scope
dreixel's avatar
dreixel committed
826
	         rnMethodBinds (unLoc cname') (mkSigTvFn sigs') mbinds
827

828 829
  -- Haddock docs 
	; docs' <- mapM (wrapLocM rnDocDecl) docs
830 831 832 833

	; return (ClassDecl { tcdCtxt = context', tcdLName = cname', 
			      tcdTyVars = tyvars', tcdFDs = fds', tcdSigs = sigs',
			      tcdMeths = mbinds', tcdATs = ats', tcdDocs = docs'},
834
	     	  meth_fvs `plusFV` stuff_fvs) }
835 836
  where
    cls_doc  = text "In the declaration for class" 	<+> ppr cname
837

Ian Lynagh's avatar
Ian Lynagh committed
838 839
badGadtStupidTheta :: Located RdrName -> SDoc
badGadtStupidTheta _
Ian Lynagh's avatar
Ian Lynagh committed
840 841
  = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
	  ptext (sLit "(You can put a context on each contructor, though.)")]
842 843
\end{code}

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
844 845 846 847 848 849 850 851 852
Note [Stupid theta]
~~~~~~~~~~~~~~~~~~~
Trac #3850 complains about a regression wrt 6.10 for 
     data Show a => T a
There is no reason not to allow the stupid theta if there are no data
constructors.  It's still stupid, but does no harm, and I don't want
to cause programs to break unnecessarily (notably HList).  So if there
are no data constructors we allow h98_style = True

853

854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882
\begin{code}
depAnalTyClDecls :: [(LTyClDecl Name, FreeVars)] -> [SCC (LTyClDecl Name)]
-- See Note [Dependency analysis of type and class decls]
depAnalTyClDecls ds_w_fvs
  = stronglyConnCompFromEdgedVertices edges
  where
    edges = [ (d, tcdName (unLoc d), map get_assoc (nameSetToList fvs))
            | (d, fvs) <- ds_w_fvs ]
    get_assoc n = lookupNameEnv assoc_env n `orElse` n
    assoc_env = mkNameEnv [ (tcdName assoc_decl, cls_name) 
                          | (L _ (ClassDecl { tcdLName = L _ cls_name
                                            , tcdATs   = ats }) ,_) <- ds_w_fvs
                          , L _ assoc_decl <- ats ]
\end{code}

Note [Dependency analysis of type and class decls]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We need to do dependency analysis on type and class declarations
else we get bad error messages.  Consider

     data T f a = MkT f a
     data S f a = MkS f (T f a)

This has a kind error, but the error message is better if you
check T first, (fixing its kind) and *then* S.  If you do kind
inference together, you might get an error reported in S, which
is jolly confusing.  See Trac #4875


883 884
%*********************************************************
%*							*
885
\subsection{Support code for type/data declarations}
886 887 888 889
%*							*
%*********************************************************

\begin{code}
890
rnTyPats :: SDoc -> Located Name -> Maybe [LHsType RdrName] -> RnM (Maybe [LHsType Name], FreeVars)
891
-- Although, we are processing type patterns here, all type variables will
892 893
-- already be in scope (they are the same as in the 'tcdTyVars' field of the
-- type declaration to which these patterns belong)
894 895 896 897 898 899 900
rnTyPats _   _  Nothing
  = return (Nothing, emptyFVs)
rnTyPats doc tc (Just typats) 
  = do { typats' <- rnLHsTypes doc typats
       ; let fvs = addOneFV (extractHsTyNames_s typats') (unLoc tc)
       	     -- type instance => use, hence addOneFV
       ; return (Just typats', fvs) }
901

902 903 904 905
rnConDecls :: [LConDecl RdrName] -> RnM ([LConDecl Name], FreeVars)
rnConDecls condecls
  = do { condecls' <- mapM (wrapLocM rnConDecl) condecls
       ; return (condecls', plusFVs (map conDeclFVs condecls')) }
906

907
rnConDecl :: ConDecl RdrName -> RnM (ConDecl Name)
908
rnConDecl decl@(ConDecl { con_name = name, con_qvars = tvs
909 910 911
                   	       , con_cxt = cxt, con_details = details
                   	       , con_res = res_ty, con_doc = mb_doc
                   	       , con_old_rec = old_rec, con_explicit = expl })
912
  = do	{ addLocM checkConName name
913
    	; when old_rec (addWarn (deprecRecSyntax decl))
914
	; new_name <- lookupLocatedTopBndrRn name
915 916 917 918 919 920 921 922 923 924

    	   -- For H98 syntax, the tvs are the existential ones
	   -- For GADT syntax, the tvs are all the quantified tyvars
	   -- Hence the 'filter' in the ResTyH98 case only
        ; rdr_env <- getLocalRdrEnv
        ; let in_scope     = (`elemLocalRdrEnv` rdr_env) . unLoc
	      arg_tys      = hsConDeclArgTys details
	      implicit_tvs = case res_ty of
	      	    	       ResTyH98 -> filterOut in_scope (get_rdr_tvs arg_tys)
	      	    	       ResTyGADT ty -> get_rdr_tvs (ty : arg_tys)
925 926 927
	      new_tvs = case expl of
	        	  Explicit -> tvs
		    	  Implicit -> userHsTyVarBndrs implicit_tvs
928

929
        ; mb_doc' <- rnMbLHsDoc mb_doc 
930

931
        ; bindTyVarsRn new_tvs $ \new_tyvars -> do
932
	{ new_context <- rnContext doc cxt
933
	; new_details <- rnConDeclDetails doc details
934
        ; (new_details', new_res_ty)  <- rnConResult doc new_details res_ty
935 936
        ; return (decl { con_name = new_name, con_qvars = new_tyvars, con_cxt = new_context 
                       , con_details = new_details', con_res = new_res_ty, con_doc = mb_doc' }) }}
937
 where
938
    doc = text "In the definition of data constructor" <+> quotes (ppr name)
939 940
    get_rdr_tvs tys  = extractHsRhoRdrTyVars cxt (noLoc (HsTupleTy Boxed tys))

Ian Lynagh's avatar
Ian Lynagh committed
941 942 943 944 945
rnConResult :: SDoc
            -> HsConDetails (LHsType Name) [ConDeclField Name]
            -> ResType RdrName
            -> RnM (HsConDetails (LHsType Name) [ConDeclField Name],
                    ResType Name)
946
rnConResult _ details ResTyH98 = return (details, ResTyH98)
947 948 949 950 951 952 953 954 955 956 957 958 959 960 961 962
rnConResult doc details (ResTyGADT ty)
  = do { ty' <- rnLHsType doc ty
       ; let (arg_tys, res_ty) = splitHsFunType ty'
          	-- We can finally split it up, 
		-- now the renamer has dealt with fixities
	        -- See Note [Sorting out the result type] in RdrHsSyn

             details' = case details of
       	     	           RecCon {}    -> details
			   PrefixCon {} -> PrefixCon arg_tys
			   InfixCon {}  -> pprPanic "rnConResult" (ppr ty)
			  -- See Note [Sorting out the result type] in RdrHsSyn
		
       ; when (not (null arg_tys) && case details of { RecCon {} -> True; _ -> False })
              (addErr (badRecResTy doc))
       ; return (details', ResTyGADT res_ty) }
963