HsDecls.lhs 13.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
	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 CStrings		( CLabelString )
35
import Outputable	
36
import SrcLoc		( SrcLoc )
sof's avatar
sof committed
37
import Util
38 39
\end{code}

40 41 42 43 44 45 46 47

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

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

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

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

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

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

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

107

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

\begin{code}
115
data TyClDecl name pat
sof's avatar
sof committed
116
  = TyData	NewOrData
117 118 119 120 121 122 123 124
		(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...
125 126 127 128
		(DataPragmas name)
		SrcLoc

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

133
  | ClassDecl	(HsContext name)    	-- context...
134 135
		name		    	-- name of the class
		[HsTyVar name]	    	-- the class type variables
136
		[([name], [name])]	-- functional dependencies
137
		[Sig name]		-- methods' signatures
138 139
		(MonoBinds name pat)	-- default methods
		(ClassPragmas name)
140 141 142
		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.
143
		SrcLoc
144 145 146
\end{code}

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

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

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

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

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

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

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

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

185
    ppr (ClassDecl context clas tyvars fds sigs methods pragmas _ _ _ _ src_loc)
186 187 188 189 190 191 192 193 194
      | 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
195
        top_matter = hsep [ptext SLIT("class"), pprHsContext context,
196
                            ppr clas, hsep (map (ppr) tyvars), pprFundeps fds]
197 198 199
	ppr_sig sig = ppr sig <> semi


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

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

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

226
instance (Outputable name)
227 228
	      => Outputable (SpecDataSig name) where

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

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

\begin{code}
data ConDecl name
241 242 243 244 245
  = 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
246 247

		[HsTyVar name]		-- Existentially quantified type variables
248
		(HsContext name)	-- ...and context
249 250
					-- If both are empty then there are no existentials

sof's avatar
sof committed
251
		(ConDetails name)
252 253
		SrcLoc

sof's avatar
sof committed
254 255 256 257 258 259
data ConDetails name
  = VanillaCon			-- prefix-style con decl
		[BangType name]

  | InfixCon			-- infix-style con decl
		(BangType name)
260 261
		(BangType name)

sof's avatar
sof committed
262
  | RecCon			-- record-style con decl
263
		[([name], BangType name)]	-- list of "fields"
264

sof's avatar
sof committed
265
  | NewCon	 		-- newtype con decl, possibly with a labelled field.
266
		(HsType name)
sof's avatar
sof committed
267
		(Maybe name)	-- Just x => labelled field 'x'
268 269

data BangType name
270 271
  = Banged   (HsType name)	-- HsType: to allow Haskell extensions
  | Unbanged (HsType name)	-- (MonoType only needed for straight Haskell)
272
  | Unpacked (HsType name)	-- Field is strict and to be unpacked if poss.
273 274 275
\end{code}

\begin{code}
276
instance (Outputable name) => Outputable (ConDecl name) where
277
    ppr (ConDecl con _ tvs cxt con_details  loc)
278
      = sep [pprForAll tvs, pprHsContext cxt, ppr_con_details con con_details]
279

280 281
ppr_con_details con (InfixCon ty1 ty2)
  = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
282

283 284
ppr_con_details con (VanillaCon tys)
  = ppr con <+> hsep (map (ppr_bang) tys)
sof's avatar
sof committed
285

sof's avatar
sof committed
286
ppr_con_details con (NewCon ty Nothing)
287
  = ppr con <+> pprParendHsType ty
288

sof's avatar
sof committed
289 290 291 292 293
ppr_con_details con (NewCon ty (Just x))
  = ppr con <+> braces pp_field 
   where
    pp_field = ppr x <+> dcolon <+> pprParendHsType ty
 
294 295
ppr_con_details con (RecCon fields)
  = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
sof's avatar
sof committed
296
  where
297
    ppr_field (ns, ty) = hsep (map (ppr) ns) <+> 
298
			 dcolon <+>
299
			 ppr_bang ty
sof's avatar
sof committed
300

301 302
ppr_bang (Banged   ty) = ptext SLIT("!") <> pprParendHsType ty
ppr_bang (Unbanged ty) = pprParendHsType ty
303
ppr_bang (Unpacked ty) = ptext SLIT("! !") <> pprParendHsType ty
304 305 306 307 308
\end{code}


%************************************************************************
%*									*
sof's avatar
sof committed
309
\subsection[InstDecl]{An instance declaration
310 311 312 313
%*									*
%************************************************************************

\begin{code}
314
data InstDecl name pat
315
  = InstDecl	(HsType name)	-- Context => Class Instance-type
316 317 318
				-- Using a polytype means that the renamer conveniently
				-- figures out the quantified type variables for us.

319
		(MonoBinds name pat)
320

321
		[Sig name]		-- User-supplied pragmatic info
322

323
		name			-- Name for the dictionary function
324 325 326 327 328

		SrcLoc
\end{code}

\begin{code}
329
instance (Outputable name, Outputable pat)
330
	      => Outputable (InstDecl name pat) where
331 332 333 334 335 336 337 338 339

    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) ]
340 341 342 343 344 345 346 347 348 349 350 351 352 353 354
\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
355
  = DefaultDecl	[HsType name]
356 357
		SrcLoc

358
instance (Outputable name)
359 360
	      => Outputable (DefaultDecl name) where

361 362
    ppr (DefaultDecl tys src_loc)
      = ptext SLIT("default") <+> parens (interpp'SP tys)
363
\end{code}
364

sof's avatar
sof committed
365 366 367 368 369 370 371 372 373 374
%************************************************************************
%*									*
\subsection{Foreign function interface declaration}
%*									*
%************************************************************************

\begin{code}
data ForeignDecl name = 
   ForeignDecl 
        name 
sof's avatar
sof committed
375
	ForKind   
sof's avatar
sof committed
376 377 378 379 380
	(HsType name)
	ExtName
	CallConv
	SrcLoc

381
instance (Outputable name)
sof's avatar
sof committed
382 383 384 385
	      => Outputable (ForeignDecl name) where

    ppr (ForeignDecl nm imp_exp ty ext_name cconv src_loc)
      = ptext SLIT("foreign") <+> ppr_imp_exp <+> pprCallConv cconv <+> 
386
        ppr ext_name <+> ppr_unsafe <+> ppr nm <+> dcolon <+> ppr ty
sof's avatar
sof committed
387 388 389
        where
         (ppr_imp_exp, ppr_unsafe) =
	   case imp_exp of
sof's avatar
sof committed
390 391 392 393 394 395 396 397 398 399
	     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
400 401 402

data ExtName
 = Dynamic 
403 404 405 406 407 408 409 410 411 412 413 414
 | 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
415 416 417 418 419 420 421 422 423 424


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}

425 426
%************************************************************************
%*									*
427
\subsection{Transformation rules}
428 429 430 431
%*									*
%************************************************************************

\begin{code}
432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449
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)
450

451 452 453
instance (Outputable name, Outputable pat)
	      => Outputable (RuleDecl name pat) where
  ppr (RuleDecl name tvs ns lhs rhs loc)
454 455 456
	= sep [text "{-# RULES" <+> doubleQuotes (ptext name),
	       pp_forall, ppr lhs, equals <+> ppr rhs,
               text "#-}" ]
457 458 459 460 461 462 463 464 465 466
	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
467
\end{code}