HsDecls.lhs 13.2 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 11 12 13 14 15 16 17
module HsDecls (
	HsDecl(..), TyClDecl(..), InstDecl(..),
	DefaultDecl(..), ForeignDecl(..), ForKind(..),
	ExtName(..), isDynamic,
	ConDecl(..), ConDetails(..), BangType(..),
	IfaceSig(..),  SpecDataSig(..), HsIdInfo(..), HsStrictnessInfo(..),
	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 HsPragmas	( DataPragmas, ClassPragmas )
24
import HsTypes
25
import HsCore		( UfExpr )
sof's avatar
sof committed
26
import BasicTypes	( Fixity, NewOrData(..) )
27
import IdInfo		( ArityInfo, UpdateInfo, InlinePragInfo, CprInfo )
28
import Demand		( Demand )
sof's avatar
sof committed
29
import CallConv		( CallConv, pprCallConv )
30 31

-- others:
32
import Outputable	
33
import SrcLoc		( SrcLoc )
sof's avatar
sof committed
34
import Util
35 36
\end{code}

37 38 39 40 41 42 43 44

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

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

-- 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

-- It's a bit wierd that the fixity decls in the ValD
-- cover all the classops and imported decls too, but it's convenient
-- For a start, it means we don't need a FixD
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 _ _ _ (Just 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 88 89 90

tyClDeclName :: TyClDecl name pat -> name
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 104 105
    ppr (FixD fd)    = ppr fd

{-	Why do we need ordering on decls?
106

sof's avatar
sof committed
107
#ifdef DEBUG
108
-- hsDeclName needs more context when DEBUG is on
109
instance (Outputable name, Outputable pat, Eq name)
110
      => Eq (HsDecl name pat) where
111 112
   d1 == d2 = hsDeclName d1 == hsDeclName d2
	
113
instance (Outputable name, Outputable pat, Ord name)
114
      => Ord (HsDecl name pat) where
115
	d1 `compare` d2 = hsDeclName d1 `compare` hsDeclName d2
sof's avatar
sof committed
116
#else
117
instance (Eq name) => Eq (HsDecl name pat) where
118 119
	d1 == d2 = hsDeclName d1 == hsDeclName d2
	
120
instance (Ord name) => Ord (HsDecl name pat) where
121
	d1 `compare` d2 = hsDeclName d1 `compare` hsDeclName d2
sof's avatar
sof committed
122
#endif
123
-}
124 125
\end{code}

126

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

\begin{code}
134
data TyClDecl name pat
sof's avatar
sof committed
135 136
  = TyData	NewOrData
		(Context name)	-- context
137
		name		-- type constructor
138
		[HsTyVar name]	-- type variables
139 140 141 142 143 144 145 146 147
		[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...
		(DataPragmas name)
		SrcLoc

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

152 153 154 155 156 157 158 159 160
  | ClassDecl	(Context name)	    		-- context...
		name		    		-- name of the class
		[HsTyVar name]	    		-- the class type variables
		[Sig name]			-- methods' signatures
		(MonoBinds name pat)	-- default methods
		(ClassPragmas name)
		name name			-- The names of the tycon and datacon for this class
						-- These are filled in by the renamer
		SrcLoc
161 162 163
\end{code}

\begin{code}
164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184
countTyClDecls :: [TyClDecl name pat] -> (Int, Int, Int, Int)
	-- class, data, newtype, synonym decls
countTyClDecls decls 
 = (length [() | ClassDecl _ _ _ _ _ _ _ _   _ <- decls],
    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

isClassDecl (ClassDecl _ _ _ _ _ _ _ _ _) = True
isClassDecl other			  = False
\end{code}

\begin{code}
185
instance (Outputable name, Outputable pat)
186
	      => Outputable (TyClDecl name pat) where
187

188 189 190
    ppr (TySynonym tycon tyvars mono_ty src_loc)
      = hang (pp_decl_head SLIT("type") empty tycon tyvars)
	     4 (ppr mono_ty)
191

192 193
    ppr (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
      = pp_tydecl
194
		  (pp_decl_head keyword (pprContext context) tycon tyvars)
195
		  (pp_condecls condecls)
196
		  derivings
sof's avatar
sof committed
197 198 199 200
      where
	keyword = case new_or_data of
			NewType  -> SLIT("newtype")
			DataType -> SLIT("data")
201

202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
    ppr (ClassDecl context clas tyvars sigs methods pragmas _ _ src_loc)
      | 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
        top_matter = hsep [ptext SLIT("class"), pprContext context,
                            ppr clas, hsep (map (ppr) tyvars)]
	ppr_sig sig = ppr sig <> semi


217 218 219
pp_decl_head str pp_context tycon tyvars
  = hsep [ptext str, pp_context, ppr tycon,
	   interppSP tyvars, ptext SLIT("=")]
220

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

224
pp_tydecl pp_head pp_decl_rhs derivings
sof's avatar
sof committed
225
  = hang pp_head 4 (sep [
226
	pp_decl_rhs,
227 228 229
	case derivings of
	  Nothing 	   -> empty
	  Just ds	   -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
230
    ])
231 232 233 234 235 236 237 238 239
\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
240
		(HsType name)
241 242
		SrcLoc

243
instance (Outputable name)
244 245
	      => Outputable (SpecDataSig name) where

246 247
    ppr (SpecDataSig tycon ty _)
      = hsep [text "{-# SPECIALIZE data", ppr ty, text "#-}"]
248 249 250 251 252 253 254 255 256 257
\end{code}

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

\begin{code}
data ConDecl name
sof's avatar
sof committed
258
  = ConDecl 	name			-- Constructor name
259 260 261 262 263

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

sof's avatar
sof committed
264
		(ConDetails name)
265 266
		SrcLoc

sof's avatar
sof committed
267 268 269 270 271 272
data ConDetails name
  = VanillaCon			-- prefix-style con decl
		[BangType name]

  | InfixCon			-- infix-style con decl
		(BangType name)
273 274
		(BangType name)

sof's avatar
sof committed
275
  | RecCon			-- record-style con decl
276
		[([name], BangType name)]	-- list of "fields"
277

sof's avatar
sof committed
278
  | NewCon	 		-- newtype con decl, possibly with a labelled field.
279
		(HsType name)
sof's avatar
sof committed
280
		(Maybe name)	-- Just x => labelled field 'x'
281 282

data BangType name
283 284
  = Banged   (HsType name)	-- HsType: to allow Haskell extensions
  | Unbanged (HsType name)	-- (MonoType only needed for straight Haskell)
285
  | Unpacked (HsType name)	-- Field is strict and to be unpacked if poss.
286 287 288
\end{code}

\begin{code}
289
instance (Outputable name) => Outputable (ConDecl name) where
290 291
    ppr (ConDecl con tvs cxt con_details  loc)
      = sep [pprForAll tvs, pprContext cxt, ppr_con_details con con_details]
292

293 294
ppr_con_details con (InfixCon ty1 ty2)
  = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
295

296 297
ppr_con_details con (VanillaCon tys)
  = ppr con <+> hsep (map (ppr_bang) tys)
sof's avatar
sof committed
298

sof's avatar
sof committed
299
ppr_con_details con (NewCon ty Nothing)
300
  = ppr con <+> pprParendHsType ty
301

sof's avatar
sof committed
302 303 304 305 306
ppr_con_details con (NewCon ty (Just x))
  = ppr con <+> braces pp_field 
   where
    pp_field = ppr x <+> dcolon <+> pprParendHsType ty
 
307 308
ppr_con_details con (RecCon fields)
  = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
sof's avatar
sof committed
309
  where
310
    ppr_field (ns, ty) = hsep (map (ppr) ns) <+> 
311
			 dcolon <+>
312
			 ppr_bang ty
sof's avatar
sof committed
313

314 315
ppr_bang (Banged   ty) = ptext SLIT("!") <> pprParendHsType ty
ppr_bang (Unbanged ty) = pprParendHsType ty
316
ppr_bang (Unpacked ty) = ptext SLIT("! !") <> pprParendHsType ty
317 318 319 320 321
\end{code}


%************************************************************************
%*									*
sof's avatar
sof committed
322
\subsection[InstDecl]{An instance declaration
323 324 325 326
%*									*
%************************************************************************

\begin{code}
327
data InstDecl name pat
328
  = InstDecl	(HsType name)	-- Context => Class Instance-type
329 330 331
				-- Using a polytype means that the renamer conveniently
				-- figures out the quantified type variables for us.

332
		(MonoBinds name pat)
333

334
		[Sig name]		-- User-supplied pragmatic info
335

336
		(Maybe name)		-- Name for the dictionary function
337 338 339 340 341

		SrcLoc
\end{code}

\begin{code}
342
instance (Outputable name, Outputable pat)
343
	      => Outputable (InstDecl name pat) where
344 345 346 347 348 349 350 351 352

    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) ]
353 354 355 356 357 358 359 360 361 362 363 364 365 366 367
\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
368
  = DefaultDecl	[HsType name]
369 370
		SrcLoc

371
instance (Outputable name)
372 373
	      => Outputable (DefaultDecl name) where

374 375
    ppr (DefaultDecl tys src_loc)
      = ptext SLIT("default") <+> parens (interpp'SP tys)
376
\end{code}
377

sof's avatar
sof committed
378 379 380 381 382 383 384 385 386 387
%************************************************************************
%*									*
\subsection{Foreign function interface declaration}
%*									*
%************************************************************************

\begin{code}
data ForeignDecl name = 
   ForeignDecl 
        name 
sof's avatar
sof committed
388
	ForKind   
sof's avatar
sof committed
389 390 391 392 393
	(HsType name)
	ExtName
	CallConv
	SrcLoc

394
instance (Outputable name)
sof's avatar
sof committed
395 396 397 398
	      => Outputable (ForeignDecl name) where

    ppr (ForeignDecl nm imp_exp ty ext_name cconv src_loc)
      = ptext SLIT("foreign") <+> ppr_imp_exp <+> pprCallConv cconv <+> 
399
        ppr ext_name <+> ppr_unsafe <+> ppr nm <+> dcolon <+> ppr ty
sof's avatar
sof committed
400 401 402
        where
         (ppr_imp_exp, ppr_unsafe) =
	   case imp_exp of
sof's avatar
sof committed
403 404 405 406 407 408 409 410 411 412
	     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
413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430

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}

431 432 433 434 435 436 437 438 439 440 441 442 443
%************************************************************************
%*									*
\subsection{Signatures in interface files}
%*									*
%************************************************************************

\begin{code}
data IfaceSig name
  = IfaceSig	name
		(HsType name)
		[HsIdInfo name]
		SrcLoc

444
instance (Outputable name) => Outputable (IfaceSig name) where
445
    ppr (IfaceSig var ty _ _)
446
      = hang (hsep [ppr var, dcolon])
447
	     4 (ppr ty)
448 449 450

data HsIdInfo name
  = HsArity		ArityInfo
451
  | HsStrictness	HsStrictnessInfo
452
  | HsUnfold		InlinePragInfo (Maybe (UfExpr name))
453
  | HsUpdate		UpdateInfo
454
  | HsSpecialise	[HsTyVar name] [HsType name] (UfExpr name)
455
  | HsNoCafRefs
456
  | HsCprInfo           CprInfo
457 458
  | HsWorker		name [name]		-- Worker, if any
						-- and needed constructors
459

460
data HsStrictnessInfo
461
  = HsStrictnessInfo ([Demand], Bool)
sof's avatar
sof committed
462
  | HsBottom
463
\end{code}