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 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 )
28
import Demand		( Demand )
sof's avatar
sof committed
29
import CallConv		( CallConv, pprCallConv )
30 31

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

38 39 40 41 42 43 44 45

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

\begin{code}
46 47 48
data HsDecl name pat
  = TyClD	(TyClDecl name pat)
  | InstD	(InstDecl  name pat)
49
  | DefD	(DefaultDecl name)
50
  | ValD	(HsBinds name pat)
sof's avatar
sof committed
51
  | ForD        (ForeignDecl name)
52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70
  | 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
71 72 73
\end{code}

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

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

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

98
    ppr (TyClD dcl)  = ppr dcl
99 100 101 102
    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
103
    ppr (ForD fd)    = ppr fd
104 105 106
    ppr (FixD fd)    = ppr fd

{-	Why do we need ordering on decls?
107

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

127

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

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

153 154 155 156 157 158 159 160 161
  | 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
162 163 164
\end{code}

\begin{code}
165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187
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}
instance (NamedThing name, Outputable name, Outputable pat)
	      => Outputable (TyClDecl name pat) where
188

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

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

203 204 205 206 207 208 209 210 211 212 213 214 215 216 217
    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


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

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

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

instance (NamedThing name, Outputable name)
	      => Outputable (SpecDataSig name) where

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

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

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

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

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

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

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

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

sof's avatar
sof committed
279
  | NewCon	 		-- newtype con decl
280
		(HsType name)
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 286 287 288
\end{code}

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

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

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

298 299
ppr_con_details con (NewCon ty)
  = ppr con <+> pprParendHsType ty
300

301 302
ppr_con_details con (RecCon fields)
  = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
sof's avatar
sof committed
303
  where
304
    ppr_field (ns, ty) = hsep (map (ppr) ns) <+> 
305
			 dcolon <+>
306
			 ppr_bang ty
sof's avatar
sof committed
307

308 309
ppr_bang (Banged   ty) = ptext SLIT("!") <> pprParendHsType ty
ppr_bang (Unbanged ty) = pprParendHsType ty
310 311 312 313 314
\end{code}


%************************************************************************
%*									*
sof's avatar
sof committed
315
\subsection[InstDecl]{An instance declaration
316 317 318 319
%*									*
%************************************************************************

\begin{code}
320
data InstDecl name pat
321
  = InstDecl	(HsType name)	-- Context => Class Instance-type
322 323 324
				-- Using a polytype means that the renamer conveniently
				-- figures out the quantified type variables for us.

325
		(MonoBinds name pat)
326

327
		[Sig name]		-- User-supplied pragmatic info
328

329
		(Maybe name)		-- Name for the dictionary function
330 331 332 333 334

		SrcLoc
\end{code}

\begin{code}
335
instance (NamedThing name, Outputable name, Outputable pat)
336
	      => Outputable (InstDecl name pat) where
337 338 339 340 341 342 343 344 345

    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) ]
346 347 348 349 350 351 352 353 354 355 356 357 358 359 360
\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
361
  = DefaultDecl	[HsType name]
362 363 364 365 366
		SrcLoc

instance (NamedThing name, Outputable name)
	      => Outputable (DefaultDecl name) where

367 368
    ppr (DefaultDecl tys src_loc)
      = ptext SLIT("default") <+> parens (interpp'SP tys)
369
\end{code}
370

sof's avatar
sof committed
371 372 373 374 375 376 377 378 379 380
%************************************************************************
%*									*
\subsection{Foreign function interface declaration}
%*									*
%************************************************************************

\begin{code}
data ForeignDecl name = 
   ForeignDecl 
        name 
sof's avatar
sof committed
381
	ForKind   
sof's avatar
sof committed
382 383 384 385 386 387 388 389 390 391
	(HsType name)
	ExtName
	CallConv
	SrcLoc

instance (NamedThing name, Outputable name)
	      => Outputable (ForeignDecl name) where

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

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}

424 425 426 427 428 429 430 431 432 433 434 435 436 437
%************************************************************************
%*									*
\subsection{Signatures in interface files}
%*									*
%************************************************************************

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

instance (NamedThing name, Outputable name) => Outputable (IfaceSig name) where
438
    ppr (IfaceSig var ty _ _)
439
      = hang (hsep [ppr var, dcolon])
440
	     4 (ppr ty)
441 442 443

data HsIdInfo name
  = HsArity		ArityInfo
sof's avatar
sof committed
444
  | HsStrictness	(HsStrictnessInfo name)
445
  | HsUnfold		InlinePragInfo (Maybe (UfExpr name))
446
  | HsUpdate		UpdateInfo
447
  | HsSpecialise	[HsTyVar name] [HsType name] (UfExpr name)
448
  | HsNoCafRefs
449

sof's avatar
sof committed
450 451

data HsStrictnessInfo name
452
  = HsStrictnessInfo ([Demand], Bool)
sof's avatar
sof committed
453 454 455
		     (Maybe (name, [name]))	-- Worker, if any
						-- and needed constructors
  | HsBottom
456
\end{code}