HsDecls.lhs 18.7 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 4 5
%
\section[HsDecls]{Abstract syntax: global declarations}

6
Definitions for: @TyDecl@ and @ConDecl@, @ClassDecl@,
sof's avatar
sof committed
7
@InstDecl@, @DefaultDecl@ and @ForeignDecl@.
8 9

\begin{code}
10
module HsDecls (
11
	HsDecl(..), TyClDecl(..), InstDecl(..), RuleDecl(..), RuleBndr(..),
12
	DefaultDecl(..), ForeignDecl(..), ForKind(..),
13
	ExtName(..), isDynamicExtName, extNameStatic,
14
	ConDecl(..), ConDetails(..), BangType(..),
15
	IfaceSig(..),  SpecDataSig(..), 
16 17
	DeprecDecl(..), DeprecTxt,
	hsDeclName, tyClDeclName, isClassDecl, isSynDecl, isDataDecl, countTyClDecls, toHsRule
18
    ) where
19

20
#include "HsVersions.h"
21 22

-- friends:
23
import HsBinds		( HsBinds, MonoBinds, Sig(..), FixitySig(..), nullMonoBinds )
24
import HsExpr		( HsExpr )
25
import HsPragmas	( DataPragmas, ClassPragmas )
26
import HsImpExp		( IE(..) )
27
import HsTypes
28 29 30
import PprCore		( pprCoreRule )
import HsCore		( UfExpr(UfVar), UfBinder, IfaceSig(..), eq_ufBinders, eq_ufExpr, pprUfExpr, toUfExpr, toUfBndr )
import CoreSyn		( CoreRule(..) )
sof's avatar
sof committed
31
import BasicTypes	( Fixity, NewOrData(..) )
sof's avatar
sof committed
32
import CallConv		( CallConv, pprCallConv )
33 34
import Var		( TyVar, Id )
import Name		( toRdrName )
35 36

-- others:
37
import PprType
38 39
import FunDeps		( pprFundeps )
import Class		( FunDep )
40
import CStrings		( CLabelString, pprCLabelString )
41
import Outputable	
42
import SrcLoc		( SrcLoc, noSrcLoc )
sof's avatar
sof committed
43
import Util
44 45
\end{code}

46 47 48 49 50 51 52 53

%************************************************************************
%*									*
\subsection[HsDecl]{Declarations}
%*									*
%************************************************************************

\begin{code}
54 55 56
data HsDecl name pat
  = TyClD	(TyClDecl name pat)
  | InstD	(InstDecl  name pat)
57
  | DefD	(DefaultDecl name)
58
  | ValD	(HsBinds name pat)
sof's avatar
sof committed
59
  | ForD        (ForeignDecl name)
60 61
  | SigD	(IfaceSig name)
  | FixD	(FixitySig name)
62
  | DeprecD	(DeprecDecl name)
63
  | RuleD	(RuleDecl name pat)
64 65 66 67 68 69 70 71 72 73 74 75 76

-- NB: all top-level fixity decls are contained EITHER
-- EITHER FixDs
-- OR     in the ClassDecls in TyClDs
--
-- The former covers
-- 	a) data constructors
-- 	b) class methods (but they can be also done in the
-- 		signatures of class decls)
--	c) imported functions (that have an IfacSig)
--	d) top level decls
--
-- The latter is for class methods only
77 78 79
\end{code}

\begin{code}
sof's avatar
sof committed
80
#ifdef DEBUG
81
hsDeclName :: (Outputable name, Outputable pat)
82
	   => HsDecl name pat -> name
sof's avatar
sof committed
83
#endif
84 85 86 87 88
hsDeclName (TyClD decl)				  = tyClDeclName decl
hsDeclName (SigD    (IfaceSig name _ _ _))	  = name
hsDeclName (InstD   (InstDecl _ _ _ name _))      = name
hsDeclName (ForD    (ForeignDecl name _ _ _ _ _)) = name
hsDeclName (FixD    (FixitySig name _ _))	  = name
89
-- Others don't make sense
sof's avatar
sof committed
90
#ifdef DEBUG
91
hsDeclName x				      = pprPanic "HsDecls.hsDeclName" (ppr x)
sof's avatar
sof committed
92
#endif
93 94

tyClDeclName :: TyClDecl name pat -> name
95
tyClDeclName (TyData _ _ name _ _ _ _ _ _)          = name
96 97
tyClDeclName (TySynonym name _ _ _)                 = name
tyClDeclName (ClassDecl _ name _ _ _ _ _ _ _ _ _ _) = name
98 99 100
\end{code}

\begin{code}
101
instance (Outputable name, Outputable pat)
102
	=> Outputable (HsDecl name pat) where
103

104
    ppr (TyClD dcl)  = ppr dcl
105 106 107 108
    ppr (SigD sig)   = ppr sig
    ppr (ValD binds) = ppr binds
    ppr (DefD def)   = ppr def
    ppr (InstD inst) = ppr inst
sof's avatar
sof committed
109
    ppr (ForD fd)    = ppr fd
110
    ppr (FixD fd)    = ppr fd
111
    ppr (RuleD rd)   = ppr rd
112 113 114 115 116 117 118
    ppr (DeprecD dd) = ppr dd
\end{code}

\begin{code}
instance Ord name => Eq (HsDecl name pat) where
	-- Used only when comparing interfaces, 
	-- at which time only signature and type/class decls
119
   (SigD s1)  == (SigD s2)  = s1 == s2
120
   (TyClD d1) == (TyClD d2) = d1 == d2
121
   _          == _          = False
122 123
\end{code}

124

125 126 127 128 129 130 131
%************************************************************************
%*									*
\subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
%*									*
%************************************************************************

\begin{code}
132
data TyClDecl name pat
sof's avatar
sof committed
133
  = TyData	NewOrData
134 135
		(HsContext name) -- context
		name		 -- type constructor
136
		[HsTyVarBndr name]	 -- type variables
137
		[ConDecl name]	 -- data constructors (empty if abstract)
138
		Int		 -- Number of data constructors (valid even if type is abstract)
139 140 141 142
		(Maybe [name])	 -- derivings; Nothing => not specified
				 -- (i.e., derive default); Just [] => derive
				 -- *nothing*; Just <list> => as you would
				 -- expect...
143 144 145 146
		(DataPragmas name)
		SrcLoc

  | TySynonym	name		-- type constructor
147
		[HsTyVarBndr name]	-- type variables
148
		(HsType name)	-- synonym expansion
149 150
		SrcLoc

151
  | ClassDecl	(HsContext name)    	-- context...
152
		name		    	-- name of the class
153 154
		[HsTyVarBndr name]	-- the class type variables
		[FunDep name]		-- functional dependencies
155
		[Sig name]		-- methods' signatures
156 157
		(MonoBinds name pat)	-- default methods
		(ClassPragmas name)
158 159 160
		name name name [name]	-- The names of the tycon, datacon wrapper, datacon worker,
					-- and superclass selectors for this class.
					-- These are filled in as the ClassDecl is made.
161
		SrcLoc
162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192

instance Ord name => Eq (TyClDecl name pat) where
	-- Used only when building interface files
  (==) (TyData nd1 cxt1 n1 tvs1 cons1 _ _ _ _)
       (TyData nd2 cxt2 n2 tvs2 cons2 _ _ _ _)
    = n1 == n2 &&
      nd1 == nd2 &&
      eqWithHsTyVars tvs1 tvs2 (\ env -> 
   	  eq_hsContext env cxt1 cxt2 &&
	  eqListBy (eq_ConDecl env) cons1 cons2
      )

  (==) (TySynonym n1 tvs1 ty1 _)
       (TySynonym n2 tvs2 ty2 _)
    =  n1 == n2 &&
       eqWithHsTyVars tvs1 tvs2 (\ env -> eq_hsType env ty1 ty2)

  (==) (ClassDecl cxt1 n1 tvs1 fds1 sigs1 _ _ _ _ _ _ _)
       (ClassDecl cxt2 n2 tvs2 fds2 sigs2 _ _ _ _ _ _ _)
    =  n1 == n2 &&
       eqWithHsTyVars tvs1 tvs2 (\ env -> 
	  eq_hsContext env cxt1 cxt2 &&
	  eqListBy (eq_hsFD env) fds1 fds2 &&
	  eqListBy (eq_cls_sig env) sigs1 sigs2
       )

eq_hsFD env (ns1,ms1) (ns2,ms2)
  = eqListBy (eq_hsVar env) ns1 ns2 && eqListBy (eq_hsVar env) ms1 ms2

eq_cls_sig env (ClassOpSig n1 _ b1 ty1 _) (ClassOpSig n2 _ b2 ty2 _)
  = n1==n2 && b1==b2 && eq_hsType env ty1 ty2
193 194 195
\end{code}

\begin{code}
196 197 198
countTyClDecls :: [TyClDecl name pat] -> (Int, Int, Int, Int)
	-- class, data, newtype, synonym decls
countTyClDecls decls 
199
 = (length [() | ClassDecl _ _ _ _ _ _ _ _ _ _ _ _ <- decls],
200 201
    length [() | TyData DataType _ _ _ _ _ _ _ _   <- decls],
    length [() | TyData NewType  _ _ _ _ _ _ _ _   <- decls],
202
    length [() | TySynonym _ _ _ _	           <- decls])
203 204 205 206 207 208

isDataDecl, isSynDecl, isClassDecl :: TyClDecl name pat -> Bool

isSynDecl (TySynonym _ _ _ _) = True
isSynDecl other		      = False

209 210
isDataDecl (TyData _ _ _ _ _ _ _ _ _) = True
isDataDecl other		      = False
211

212 213
isClassDecl (ClassDecl _ _ _ _ _ _ _ _ _ _ _ _) = True
isClassDecl other		 	        = False
214 215 216
\end{code}

\begin{code}
217
instance (Outputable name, Outputable pat)
218
	      => Outputable (TyClDecl name pat) where
219

220
    ppr (TySynonym tycon tyvars mono_ty src_loc)
221
      = hang (ptext SLIT("type") <+> pp_decl_head [] tycon tyvars <+> equals)
222
	     4 (ppr mono_ty)
223

224
    ppr (TyData new_or_data context tycon tyvars condecls ncons derivings pragmas src_loc)
225
      = pp_tydecl
226 227
		  (ptext keyword <+> pp_decl_head context tycon tyvars <+> equals)
		  (pp_condecls condecls ncons)
228
		  derivings
sof's avatar
sof committed
229 230 231 232
      where
	keyword = case new_or_data of
			NewType  -> SLIT("newtype")
			DataType -> SLIT("data")
233

234
    ppr (ClassDecl context clas tyvars fds sigs methods pragmas _ _ _ _ src_loc)
235 236 237 238 239
      | null sigs	-- No "where" part
      = top_matter

      | otherwise	-- Laid out
      = sep [hsep [top_matter, ptext SLIT("where {")],
240
	     nest 4 (sep [sep (map ppr_sig sigs), pp_methods, char '}'])]
241
      where
242
        top_matter  = ptext SLIT("class") <+> pp_decl_head context clas tyvars <+> pprFundeps fds
243
	ppr_sig sig = ppr sig <> semi
244 245 246
	pp_methods = getPprStyle $ \ sty ->
        	     if ifaceStyle sty then empty else ppr methods
        
247

248 249
pp_decl_head :: Outputable name => HsContext name -> name -> [HsTyVarBndr name] -> SDoc
pp_decl_head context thing tyvars = hsep [pprHsContext context, ppr thing, interppSP tyvars]
250

251 252
pp_condecls []     ncons = ptext SLIT("{- abstract with") <+> int ncons <+> ptext SLIT("constructors -}")
pp_condecls (c:cs) ncons = sep (ppr c : map (\ c -> ptext SLIT("|") <+> ppr c) cs)
253

254
pp_tydecl pp_head pp_decl_rhs derivings
sof's avatar
sof committed
255
  = hang pp_head 4 (sep [
256
	pp_decl_rhs,
257 258 259
	case derivings of
	  Nothing 	   -> empty
	  Just ds	   -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
260
    ])
261 262 263 264 265 266 267 268 269
\end{code}

A type for recording what types a datatype should be specialised to.
It's called a ``Sig'' because it's sort of like a ``type signature''
for an datatype declaration.

\begin{code}
data SpecDataSig name
  = SpecDataSig name		-- tycon to specialise
270
		(HsType name)
271 272
		SrcLoc

273
instance (Outputable name)
274 275
	      => Outputable (SpecDataSig name) where

276 277
    ppr (SpecDataSig tycon ty _)
      = hsep [text "{-# SPECIALIZE data", ppr ty, text "#-}"]
278 279 280 281 282 283 284 285 286 287
\end{code}

%************************************************************************
%*									*
\subsection[ConDecl]{A data-constructor declaration}
%*									*
%************************************************************************

\begin{code}
data ConDecl name
288 289 290 291 292
  = ConDecl 	name			-- Constructor name; this is used for the
					-- DataCon itself, and for the user-callable wrapper Id

		name			-- Name of the constructor's 'worker Id'
					-- Filled in as the ConDecl is built
293

294
		[HsTyVarBndr name]		-- Existentially quantified type variables
295
		(HsContext name)	-- ...and context
296 297
					-- If both are empty then there are no existentials

sof's avatar
sof committed
298
		(ConDetails name)
299 300
		SrcLoc

sof's avatar
sof committed
301 302 303 304 305 306
data ConDetails name
  = VanillaCon			-- prefix-style con decl
		[BangType name]

  | InfixCon			-- infix-style con decl
		(BangType name)
307 308
		(BangType name)

sof's avatar
sof committed
309
  | RecCon			-- record-style con decl
310
		[([name], BangType name)]	-- list of "fields"
311

sof's avatar
sof committed
312
  | NewCon	 		-- newtype con decl, possibly with a labelled field.
313
		(HsType name)
sof's avatar
sof committed
314
		(Maybe name)	-- Just x => labelled field 'x'
315 316

data BangType name
317 318
  = Banged   (HsType name)	-- HsType: to allow Haskell extensions
  | Unbanged (HsType name)	-- (MonoType only needed for straight Haskell)
319
  | Unpacked (HsType name)	-- Field is strict and to be unpacked if poss.
320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343


eq_ConDecl env (ConDecl n1 _ tvs1 cxt1 cds1 _)
	       (ConDecl n2 _ tvs2 cxt2 cds2 _)
  = n1 == n2 &&
    (eqWithHsTyVars tvs1 tvs2	$ \ env ->
     eq_hsContext env cxt1 cxt2	&&
     eq_ConDetails env cds1 cds2)

eq_ConDetails env (VanillaCon bts1) (VanillaCon bts2)
  = eqListBy (eq_btype env) bts1 bts2
eq_ConDetails env (InfixCon bta1 btb1) (InfixCon bta2 btb2)
  = eq_btype env bta1 bta2 && eq_btype env btb1 btb2
eq_ConDetails env (RecCon fs1) (RecCon fs2)
  = eqListBy (eq_fld env) fs1 fs2
eq_ConDetails env (NewCon t1 mn1) (NewCon t2 mn2)
  = eq_hsType env t1 t2 && mn1 == mn2
eq_ConDetails env _ _ = False

eq_fld env (ns1,bt1) (ns2, bt2) = ns1==ns2 && eq_btype env bt1 bt2

eq_btype env (Banged t1)   (Banged t2)   = eq_hsType env t1 t2
eq_btype env (Unbanged t1) (Unbanged t2) = eq_hsType env t1 t2
eq_btype env (Unpacked t1) (Unpacked t2) = eq_hsType env t1 t2
344
eq_btype env _             _             = False
345 346 347
\end{code}

\begin{code}
348
instance (Outputable name) => Outputable (ConDecl name) where
349
    ppr (ConDecl con _ tvs cxt con_details  loc)
350
      = sep [pprHsForAll tvs cxt, ppr_con_details con con_details]
351

352 353
ppr_con_details con (InfixCon ty1 ty2)
  = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
354

355 356
ppr_con_details con (VanillaCon tys)
  = ppr con <+> hsep (map (ppr_bang) tys)
sof's avatar
sof committed
357

sof's avatar
sof committed
358
ppr_con_details con (NewCon ty Nothing)
359
  = ppr con <+> pprParendHsType ty
360

sof's avatar
sof committed
361 362 363 364 365
ppr_con_details con (NewCon ty (Just x))
  = ppr con <+> braces pp_field 
   where
    pp_field = ppr x <+> dcolon <+> pprParendHsType ty
 
366 367
ppr_con_details con (RecCon fields)
  = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
sof's avatar
sof committed
368
  where
369
    ppr_field (ns, ty) = hsep (map (ppr) ns) <+> 
370
			 dcolon <+>
371
			 ppr_bang ty
sof's avatar
sof committed
372

373 374 375
instance Outputable name => Outputable (BangType name) where
    ppr = ppr_bang

376 377
ppr_bang (Banged   ty) = ptext SLIT("!") <> pprParendHsType ty
ppr_bang (Unbanged ty) = pprParendHsType ty
378
ppr_bang (Unpacked ty) = ptext SLIT("! !") <> pprParendHsType ty
379 380 381 382 383
\end{code}


%************************************************************************
%*									*
sof's avatar
sof committed
384
\subsection[InstDecl]{An instance declaration
385 386 387 388
%*									*
%************************************************************************

\begin{code}
389
data InstDecl name pat
390
  = InstDecl	(HsType name)	-- Context => Class Instance-type
391 392 393
				-- Using a polytype means that the renamer conveniently
				-- figures out the quantified type variables for us.

394
		(MonoBinds name pat)
395

396
		[Sig name]		-- User-supplied pragmatic info
397

398
		name			-- Name for the dictionary function
399 400 401 402 403

		SrcLoc
\end{code}

\begin{code}
404
instance (Outputable name, Outputable pat)
405
	      => Outputable (InstDecl name pat) where
406 407 408

    ppr (InstDecl inst_ty binds uprags dfun_name src_loc)
      = getPprStyle $ \ sty ->
409 410
        if ifaceStyle sty then
           hsep [ptext SLIT("instance"), ppr inst_ty, equals, ppr dfun_name]
411 412 413 414
	else
	   vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
	         nest 4 (ppr uprags),
	         nest 4 (ppr binds) ]
415 416
\end{code}

417 418 419 420 421 422 423
\begin{code}
instance Ord name => Eq (InstDecl name pat) where
	-- Used for interface comparison only, so don't compare bindings
  (==) (InstDecl inst_ty1 _ _ dfun1 _) (InstDecl inst_ty2 _ _ dfun2 _)
       = inst_ty1 == inst_ty2 && dfun1 == dfun2
\end{code}

424 425 426 427 428 429 430 431 432 433 434 435 436

%************************************************************************
%*									*
\subsection[DefaultDecl]{A @default@ declaration}
%*									*
%************************************************************************

There can only be one default declaration per module, but it is hard
for the parser to check that; we pass them all through in the abstract
syntax, and that restriction must be checked in the front end.

\begin{code}
data DefaultDecl name
437
  = DefaultDecl	[HsType name]
438 439
		SrcLoc

440
instance (Outputable name)
441 442
	      => Outputable (DefaultDecl name) where

443 444
    ppr (DefaultDecl tys src_loc)
      = ptext SLIT("default") <+> parens (interpp'SP tys)
445
\end{code}
446

sof's avatar
sof committed
447 448 449 450 451 452 453 454 455 456
%************************************************************************
%*									*
\subsection{Foreign function interface declaration}
%*									*
%************************************************************************

\begin{code}
data ForeignDecl name = 
   ForeignDecl 
        name 
sof's avatar
sof committed
457
	ForKind   
sof's avatar
sof committed
458 459 460 461 462
	(HsType name)
	ExtName
	CallConv
	SrcLoc

463
instance (Outputable name)
sof's avatar
sof committed
464 465 466 467
	      => Outputable (ForeignDecl name) where

    ppr (ForeignDecl nm imp_exp ty ext_name cconv src_loc)
      = ptext SLIT("foreign") <+> ppr_imp_exp <+> pprCallConv cconv <+> 
468
        ppr ext_name <+> ppr_unsafe <+> ppr nm <+> dcolon <+> ppr ty
sof's avatar
sof committed
469 470 471
        where
         (ppr_imp_exp, ppr_unsafe) =
	   case imp_exp of
sof's avatar
sof committed
472 473 474 475 476 477 478 479 480 481
	     FoLabel     -> (ptext SLIT("label"), empty)
	     FoExport    -> (ptext SLIT("export"), empty)
	     FoImport us 
		| us        -> (ptext SLIT("import"), ptext SLIT("unsafe"))
		| otherwise -> (ptext SLIT("import"), empty)

data ForKind
 = FoLabel
 | FoExport
 | FoImport Bool -- True  => unsafe call.
sof's avatar
sof committed
482 483 484

data ExtName
 = Dynamic 
485 486 487 488 489 490 491 492 493 494 495 496
 | ExtName CLabelString 	-- The external name of the foreign thing,
	   (Maybe CLabelString)	-- and optionally its DLL or module name
				-- Both of these are completely unencoded; 
				-- we just print them as they are

isDynamicExtName :: ExtName -> Bool
isDynamicExtName Dynamic = True
isDynamicExtName _	 = False

extNameStatic :: ExtName -> CLabelString
extNameStatic (ExtName f _) = f
extNameStatic Dynamic	    = panic "staticExtName: Dynamic - shouldn't ever happen."
sof's avatar
sof committed
497 498 499 500 501

instance Outputable ExtName where
  ppr Dynamic	   = ptext SLIT("dynamic")
  ppr (ExtName nm mb_mod) = 
     case mb_mod of { Nothing -> empty; Just m -> doubleQuotes (ptext m) } <+> 
502
     doubleQuotes (pprCLabelString nm)
sof's avatar
sof committed
503 504
\end{code}

505 506
%************************************************************************
%*									*
507
\subsection{Transformation rules}
508 509 510 511
%*									*
%************************************************************************

\begin{code}
512
data RuleDecl name pat
513
  = HsRule			-- Source rule
514 515 516 517 518 519 520 521
	FAST_STRING		-- Rule name
	[name]			-- Forall'd tyvars, filled in by the renamer with
				-- tyvars mentioned in sigs; then filled out by typechecker
	[RuleBndr name]		-- Forall'd term vars
	(HsExpr name pat)	-- LHS
	(HsExpr name pat)	-- RHS
	SrcLoc		

522 523 524 525 526 527
  | IfaceRule	 		-- One that's come in from an interface file; pre-typecheck
	FAST_STRING
	[UfBinder name]		-- Tyvars and term vars
	name			-- Head of lhs
	[UfExpr name]		-- Args of LHS
	(UfExpr name)		-- Pre typecheck
528 529
	SrcLoc		

530 531 532 533 534
  | IfaceRuleOut		-- Post typecheck
	name			-- Head of LHS
	CoreRule


535 536 537
data RuleBndr name
  = RuleBndr name
  | RuleBndrSig name (HsType name)
538

539 540 541 542 543 544 545
instance Ord name => Eq (RuleDecl name pat) where
  -- Works for IfaceRules only; used when comparing interface file versions
  (IfaceRule n1 bs1 f1 es1 rhs1 _) == (IfaceRule n2 bs2 f2 es2 rhs2 _)
     = n1==n2 && f1 == f2 && 
       eq_ufBinders emptyEqHsEnv bs1 bs2 (\env -> 
       eqListBy (eq_ufExpr env) (rhs1:es1) (rhs2:es2))

546 547
instance (Outputable name, Outputable pat)
	      => Outputable (RuleDecl name pat) where
548
  ppr (HsRule name tvs ns lhs rhs loc)
549 550 551
	= sep [text "{-# RULES" <+> doubleQuotes (ptext name),
	       pp_forall, ppr lhs, equals <+> ppr rhs,
               text "#-}" ]
552 553 554 555 556
	where
	  pp_forall | null tvs && null ns = empty
		    | otherwise		  = text "forall" <+> 
					    fsep (map ppr tvs ++ map ppr ns)
					    <> dot
557 558 559 560 561 562 563 564 565

  ppr (IfaceRule name tpl_vars fn tpl_args rhs loc) 
    = hsep [ doubleQuotes (ptext name),
	   ptext SLIT("__forall") <+> braces (interppSP tpl_vars),
	   ppr fn <+> sep (map (pprUfExpr parens) tpl_args),
	   ptext SLIT("=") <+> ppr rhs
      ] <+> semi

  ppr (IfaceRuleOut fn rule) = pprCoreRule (ppr fn) rule
566 567 568 569

instance Outputable name => Outputable (RuleBndr name) where
   ppr (RuleBndr name) = ppr name
   ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601

toHsRule id (BuiltinRule _)
  = pprTrace "toHsRule: builtin" (ppr id) (bogusIfaceRule id)

toHsRule id (Rule name bndrs args rhs)
  = IfaceRule name (map toUfBndr bndrs) (toRdrName id)
	      (map toUfExpr args) (toUfExpr rhs) noSrcLoc

bogusIfaceRule id
  = IfaceRule SLIT("bogus") [] (toRdrName id) [] (UfVar (toRdrName id)) noSrcLoc
\end{code}


%************************************************************************
%*									*
\subsection[DeprecDecl]{Deprecations}
%*									*
%************************************************************************

We use exported entities for things to deprecate. Cunning trick (hack?):
`IEModuleContents undefined' is used for module deprecation.

\begin{code}
data DeprecDecl name = Deprecation (IE name) DeprecTxt SrcLoc

type DeprecTxt = FAST_STRING	-- reason/explanation for deprecation

instance Outputable name => Outputable (DeprecDecl name) where
   ppr (Deprecation (IEModuleContents _) txt _)
      = hsep [text "{-# DEPRECATED",            doubleQuotes (ppr txt), text "#-}"]
   ppr (Deprecation thing txt _)
      = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
602
\end{code}