HsDecls.lhs 13 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 13 14
	DefaultDecl(..), ForeignDecl(..), ForKind(..),
	ExtName(..), isDynamic,
	ConDecl(..), ConDetails(..), BangType(..),
15
	IfaceSig(..),  SpecDataSig(..), 
16 17
	hsDeclName, tyClDeclName, isClassDecl, isSynDecl, isDataDecl, countTyClDecls
    ) where
18

19
#include "HsVersions.h"
20 21

-- friends:
22
import HsBinds		( HsBinds, MonoBinds, Sig, FixitySig(..), nullMonoBinds )
23
import HsExpr		( HsExpr )
24
import HsPragmas	( DataPragmas, ClassPragmas )
25
import HsTypes
26
import HsCore		( UfExpr, UfBinder, IfaceSig(..), UfRuleBody )
sof's avatar
sof committed
27
import BasicTypes	( Fixity, NewOrData(..) )
sof's avatar
sof committed
28
import CallConv		( CallConv, pprCallConv )
29
import Var		( TyVar )
30 31

-- others:
32
import PprType
33
import {-# SOURCE #-} FunDeps ( pprFundeps )
34
import Outputable	
35
import SrcLoc		( SrcLoc )
sof's avatar
sof committed
36
import Util
37 38
\end{code}

39 40 41 42 43 44 45 46

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

\begin{code}
47 48 49
data HsDecl name pat
  = TyClD	(TyClDecl name pat)
  | InstD	(InstDecl  name pat)
50
  | DefD	(DefaultDecl name)
51
  | ValD	(HsBinds name pat)
sof's avatar
sof committed
52
  | ForD        (ForeignDecl name)
53 54
  | SigD	(IfaceSig name)
  | FixD	(FixitySig name)
55
  | RuleD	(RuleDecl name pat)
56 57 58 59 60 61 62 63 64 65 66 67 68

-- 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
69 70 71
\end{code}

\begin{code}
sof's avatar
sof committed
72
#ifdef DEBUG
73
hsDeclName :: (Outputable name, Outputable pat)
74
	   => HsDecl name pat -> name
sof's avatar
sof committed
75
#endif
76 77 78 79 80
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
81
-- Others don't make sense
sof's avatar
sof committed
82
#ifdef DEBUG
83
hsDeclName x				      = pprPanic "HsDecls.hsDeclName" (ppr x)
sof's avatar
sof committed
84
#endif
85 86

tyClDeclName :: TyClDecl name pat -> name
87 88
tyClDeclName (TyData _ _ name _ _ _ _ _)        = name
tyClDeclName (TySynonym name _ _ _)             = name
89
tyClDeclName (ClassDecl _ name _ _ _ _ _ _ _ _ _) = name
90 91 92
\end{code}

\begin{code}
93
instance (Outputable name, Outputable pat)
94
	=> Outputable (HsDecl name pat) where
95

96
    ppr (TyClD dcl)  = ppr dcl
97 98 99 100
    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
101
    ppr (ForD fd)    = ppr fd
102
    ppr (FixD fd)    = ppr fd
103
    ppr (RuleD rd)   = ppr rd
104 105
\end{code}

106

107 108 109 110 111 112 113
%************************************************************************
%*									*
\subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
%*									*
%************************************************************************

\begin{code}
114
data TyClDecl name pat
sof's avatar
sof committed
115
  = TyData	NewOrData
116 117 118 119 120 121 122 123
		(HsContext name) -- context
		name		 -- type constructor
		[HsTyVar name]	 -- type variables
		[ConDecl name]	 -- data constructors (empty if abstract)
		(Maybe [name])	 -- derivings; Nothing => not specified
				 -- (i.e., derive default); Just [] => derive
				 -- *nothing*; Just <list> => as you would
				 -- expect...
124 125 126 127
		(DataPragmas name)
		SrcLoc

  | TySynonym	name		-- type constructor
128 129
		[HsTyVar name]	-- type variables
		(HsType name)	-- synonym expansion
130 131
		SrcLoc

132
  | ClassDecl	(HsContext name)    	-- context...
133 134
		name		    	-- name of the class
		[HsTyVar name]	    	-- the class type variables
135
		[([name], [name])]	-- functional dependencies
136
		[Sig name]		-- methods' signatures
137 138
		(MonoBinds name pat)	-- default methods
		(ClassPragmas name)
139 140
		name name [name]	-- The names of the tycon, datacon, and superclass selectors
					-- for this class.  These are filled in as the ClassDecl is made.
141
		SrcLoc
142 143 144
\end{code}

\begin{code}
145 146 147
countTyClDecls :: [TyClDecl name pat] -> (Int, Int, Int, Int)
	-- class, data, newtype, synonym decls
countTyClDecls decls 
148
 = (length [() | ClassDecl _ _ _ _ _ _ _ _ _ _ _ <- decls],
149 150 151 152 153 154 155 156 157 158 159 160
    length [() | TyData DataType _ _ _ _ _ _ _ <- decls],
    length [() | TyData NewType  _ _ _ _ _ _ _ <- decls],
    length [() | TySynonym _ _ _ _	       <- decls])

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

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

isDataDecl (TyData _ _ _ _ _ _ _ _) = True
isDataDecl other		    = False

161
isClassDecl (ClassDecl _ _ _ _ _ _ _ _ _ _ _) = True
162
isClassDecl other		 	    = False
163 164 165
\end{code}

\begin{code}
166
instance (Outputable name, Outputable pat)
167
	      => Outputable (TyClDecl name pat) where
168

169 170 171
    ppr (TySynonym tycon tyvars mono_ty src_loc)
      = hang (pp_decl_head SLIT("type") empty tycon tyvars)
	     4 (ppr mono_ty)
172

173 174
    ppr (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
      = pp_tydecl
175
		  (pp_decl_head keyword (pprHsContext context) tycon tyvars)
176
		  (pp_condecls condecls)
177
		  derivings
sof's avatar
sof committed
178 179 180 181
      where
	keyword = case new_or_data of
			NewType  -> SLIT("newtype")
			DataType -> SLIT("data")
182

183
    ppr (ClassDecl context clas tyvars fds sigs methods pragmas _ _ _ src_loc)
184 185 186 187 188 189 190 191 192
      | null sigs	-- No "where" part
      = top_matter

      | otherwise	-- Laid out
      = sep [hsep [top_matter, ptext SLIT("where {")],
	       nest 4 (vcat [sep (map ppr_sig sigs),
				   ppr methods,
				   char '}'])]
      where
193
        top_matter = hsep [ptext SLIT("class"), pprHsContext context,
194
                            ppr clas, hsep (map (ppr) tyvars), pprFundeps fds]
195 196 197
	ppr_sig sig = ppr sig <> semi


198 199 200
pp_decl_head str pp_context tycon tyvars
  = hsep [ptext str, pp_context, ppr tycon,
	   interppSP tyvars, ptext SLIT("=")]
201

202 203
pp_condecls []     = empty		-- Curious!
pp_condecls (c:cs) = sep (ppr c : map (\ c -> ptext SLIT("|") <+> ppr c) cs)
204

205
pp_tydecl pp_head pp_decl_rhs derivings
sof's avatar
sof committed
206
  = hang pp_head 4 (sep [
207
	pp_decl_rhs,
208 209 210
	case derivings of
	  Nothing 	   -> empty
	  Just ds	   -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
211
    ])
212 213 214 215 216 217 218 219 220
\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
221
		(HsType name)
222 223
		SrcLoc

224
instance (Outputable name)
225 226
	      => Outputable (SpecDataSig name) where

227 228
    ppr (SpecDataSig tycon ty _)
      = hsep [text "{-# SPECIALIZE data", ppr ty, text "#-}"]
229 230 231 232 233 234 235 236 237 238
\end{code}

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

\begin{code}
data ConDecl name
sof's avatar
sof committed
239
  = ConDecl 	name			-- Constructor name
240 241

		[HsTyVar name]		-- Existentially quantified type variables
242
		(HsContext name)	-- ...and context
243 244
					-- If both are empty then there are no existentials

sof's avatar
sof committed
245
		(ConDetails name)
246 247
		SrcLoc

sof's avatar
sof committed
248 249 250 251 252 253
data ConDetails name
  = VanillaCon			-- prefix-style con decl
		[BangType name]

  | InfixCon			-- infix-style con decl
		(BangType name)
254 255
		(BangType name)

sof's avatar
sof committed
256
  | RecCon			-- record-style con decl
257
		[([name], BangType name)]	-- list of "fields"
258

sof's avatar
sof committed
259
  | NewCon	 		-- newtype con decl, possibly with a labelled field.
260
		(HsType name)
sof's avatar
sof committed
261
		(Maybe name)	-- Just x => labelled field 'x'
262 263

data BangType name
264 265
  = Banged   (HsType name)	-- HsType: to allow Haskell extensions
  | Unbanged (HsType name)	-- (MonoType only needed for straight Haskell)
266
  | Unpacked (HsType name)	-- Field is strict and to be unpacked if poss.
267 268 269
\end{code}

\begin{code}
270
instance (Outputable name) => Outputable (ConDecl name) where
271
    ppr (ConDecl con tvs cxt con_details  loc)
272
      = sep [pprForAll tvs, pprHsContext cxt, ppr_con_details con con_details]
273

274 275
ppr_con_details con (InfixCon ty1 ty2)
  = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
276

277 278
ppr_con_details con (VanillaCon tys)
  = ppr con <+> hsep (map (ppr_bang) tys)
sof's avatar
sof committed
279

sof's avatar
sof committed
280
ppr_con_details con (NewCon ty Nothing)
281
  = ppr con <+> pprParendHsType ty
282

sof's avatar
sof committed
283 284 285 286 287
ppr_con_details con (NewCon ty (Just x))
  = ppr con <+> braces pp_field 
   where
    pp_field = ppr x <+> dcolon <+> pprParendHsType ty
 
288 289
ppr_con_details con (RecCon fields)
  = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
sof's avatar
sof committed
290
  where
291
    ppr_field (ns, ty) = hsep (map (ppr) ns) <+> 
292
			 dcolon <+>
293
			 ppr_bang ty
sof's avatar
sof committed
294

295 296
ppr_bang (Banged   ty) = ptext SLIT("!") <> pprParendHsType ty
ppr_bang (Unbanged ty) = pprParendHsType ty
297
ppr_bang (Unpacked ty) = ptext SLIT("! !") <> pprParendHsType ty
298 299 300 301 302
\end{code}


%************************************************************************
%*									*
sof's avatar
sof committed
303
\subsection[InstDecl]{An instance declaration
304 305 306 307
%*									*
%************************************************************************

\begin{code}
308
data InstDecl name pat
309
  = InstDecl	(HsType name)	-- Context => Class Instance-type
310 311 312
				-- Using a polytype means that the renamer conveniently
				-- figures out the quantified type variables for us.

313
		(MonoBinds name pat)
314

315
		[Sig name]		-- User-supplied pragmatic info
316

317
		name			-- Name for the dictionary function
318 319 320 321 322

		SrcLoc
\end{code}

\begin{code}
323
instance (Outputable name, Outputable pat)
324
	      => Outputable (InstDecl name pat) where
325 326 327 328 329 330 331 332 333

    ppr (InstDecl inst_ty binds uprags dfun_name src_loc)
      = getPprStyle $ \ sty ->
        if ifaceStyle sty || (nullMonoBinds binds && null uprags) then
           hsep [ptext SLIT("instance"), ppr inst_ty]
	else
	   vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
	         nest 4 (ppr uprags),
	         nest 4 (ppr binds) ]
334 335 336 337 338 339 340 341 342 343 344 345 346 347 348
\end{code}


%************************************************************************
%*									*
\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
349
  = DefaultDecl	[HsType name]
350 351
		SrcLoc

352
instance (Outputable name)
353 354
	      => Outputable (DefaultDecl name) where

355 356
    ppr (DefaultDecl tys src_loc)
      = ptext SLIT("default") <+> parens (interpp'SP tys)
357
\end{code}
358

sof's avatar
sof committed
359 360 361 362 363 364 365 366 367 368
%************************************************************************
%*									*
\subsection{Foreign function interface declaration}
%*									*
%************************************************************************

\begin{code}
data ForeignDecl name = 
   ForeignDecl 
        name 
sof's avatar
sof committed
369
	ForKind   
sof's avatar
sof committed
370 371 372 373 374
	(HsType name)
	ExtName
	CallConv
	SrcLoc

375
instance (Outputable name)
sof's avatar
sof committed
376 377 378 379
	      => Outputable (ForeignDecl name) where

    ppr (ForeignDecl nm imp_exp ty ext_name cconv src_loc)
      = ptext SLIT("foreign") <+> ppr_imp_exp <+> pprCallConv cconv <+> 
380
        ppr ext_name <+> ppr_unsafe <+> ppr nm <+> dcolon <+> ppr ty
sof's avatar
sof committed
381 382 383
        where
         (ppr_imp_exp, ppr_unsafe) =
	   case imp_exp of
sof's avatar
sof committed
384 385 386 387 388 389 390 391 392 393
	     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
394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411

data ExtName
 = Dynamic 
 | ExtName FAST_STRING (Maybe FAST_STRING)

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


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) } <+> 
     doubleQuotes (ptext nm)

\end{code}

412 413
%************************************************************************
%*									*
414
\subsection{Transformation rules}
415 416 417 418
%*									*
%************************************************************************

\begin{code}
419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436
data RuleDecl name pat
  = RuleDecl
	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		

  | IfaceRuleDecl 		-- One that's come in from an interface file
	name
	(UfRuleBody name)
	SrcLoc		

data RuleBndr name
  = RuleBndr name
  | RuleBndrSig name (HsType name)
437

438 439 440
instance (Outputable name, Outputable pat)
	      => Outputable (RuleDecl name pat) where
  ppr (RuleDecl name tvs ns lhs rhs loc)
441 442 443
	= sep [text "{-# RULES" <+> doubleQuotes (ptext name),
	       pp_forall, ppr lhs, equals <+> ppr rhs,
               text "#-}" ]
444 445 446 447 448 449 450 451 452 453
	where
	  pp_forall | null tvs && null ns = empty
		    | otherwise		  = text "forall" <+> 
					    fsep (map ppr tvs ++ map ppr ns)
					    <> dot
  ppr (IfaceRuleDecl var body loc) = text "An imported rule..."

instance Outputable name => Outputable (RuleBndr name) where
   ppr (RuleBndr name) = ppr name
   ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
454
\end{code}