ghc/compiler/hsSyn/HsDecls.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[HsDecls]{Abstract syntax: global declarations}
   5
   6 Definitions for: @TyDecl@ and @ConDecl@, @ClassDecl@,
   7 @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
   8
   9 \begin{code}
  10 module HsDecls (
  11         HsDecl(..), TyClDecl(..), InstDecl(..),
  12         DefaultDecl(..), ForeignDecl(..), ForKind(..),
  13         ExtName(..), isDynamic,
  14         ConDecl(..), ConDetails(..), BangType(..),
  15         IfaceSig(..),  SpecDataSig(..), HsIdInfo(..), HsStrictnessInfo(..),
  16         hsDeclName, tyClDeclName, isClassDecl, isSynDecl, isDataDecl, countTyClDecls
  17     ) 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 )
  26 import BasicTypes       ( Fixity, NewOrData(..) )
  27 import IdInfo           ( ArityInfo, UpdateInfo, InlinePragInfo, CprInfo )
  28 import Demand           ( Demand )
  29 import CallConv         ( CallConv, pprCallConv )
  30
  31 -- others:
  32 import Outputable
  33 import SrcLoc           ( SrcLoc )
  34 import Util
  35 \end{code}
  36
  37
  38 %************************************************************************
  39 %*                                                                      *
  40 \subsection[HsDecl]{Declarations}
  41 %*                                                                      *
  42 %************************************************************************
  43
  44 \begin{code}
  45 data HsDecl name pat
  46   = TyClD       (TyClDecl name pat)
  47   | InstD       (InstDecl  name pat)
  48   | DefD        (DefaultDecl name)
  49   | ValD        (HsBinds name pat)
  50   | ForD        (ForeignDecl name)
  51   | SigD        (IfaceSig name)
  52   | FixD        (FixitySig name)
  53
  54 -- NB: all top-level fixity decls are contained EITHER
  55 -- EITHER FixDs
  56 -- OR     in the ClassDecls in TyClDs
  57 --
  58 -- The former covers
  59 --      a) data constructors
  60 --      b) class methods (but they can be also done in the
  61 --              signatures of class decls)
  62 --      c) imported functions (that have an IfacSig)
  63 --      d) top level decls
  64 --
  65 -- The latter is for class methods only
  66
  67 -- It's a bit wierd that the fixity decls in the ValD
  68 -- cover all the classops and imported decls too, but it's convenient
  69 -- For a start, it means we don't need a FixD
  70 \end{code}
  71
  72 \begin{code}
  73 #ifdef DEBUG
  74 hsDeclName :: (Outputable name, Outputable pat)
  75            => HsDecl name pat -> name
  76 #endif
  77 hsDeclName (TyClD decl)                             = tyClDeclName decl
  78 hsDeclName (SigD  (IfaceSig name _ _ _))            = name
  79 hsDeclName (InstD (InstDecl _ _ _ (Just name) _))   = name
  80 hsDeclName (ForD  (ForeignDecl name _ _ _ _ _))     = name
  81 hsDeclName (FixD  (FixitySig name _ _))             = name
  82 -- Others don't make sense
  83 #ifdef DEBUG
  84 hsDeclName x                                  = pprPanic "HsDecls.hsDeclName" (ppr x)
  85 #endif
  86
  87 tyClDeclName :: TyClDecl name pat -> name
  88 tyClDeclName (TyData _ _ name _ _ _ _ _)      = name
  89 tyClDeclName (TySynonym name _ _ _)           = name
  90 tyClDeclName (ClassDecl _ name _ _ _ _ _ _ _) = name
  91 \end{code}
  92
  93 \begin{code}
  94 instance (Outputable name, Outputable pat)
  95         => Outputable (HsDecl name pat) where
  96
  97     ppr (TyClD dcl)  = ppr dcl
  98     ppr (SigD sig)   = ppr sig
  99     ppr (ValD binds) = ppr binds
 100     ppr (DefD def)   = ppr def
 101     ppr (InstD inst) = ppr inst
 102     ppr (ForD fd)    = ppr fd
 103     ppr (FixD fd)    = ppr fd
 104
 105 {-      Why do we need ordering on decls?
 106
 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    d1 == d2 = hsDeclName d1 == hsDeclName d2
 112
 113 instance (Outputable name, Outputable pat, Ord name)
 114       => Ord (HsDecl name pat) where
 115         d1 `compare` d2 = hsDeclName d1 `compare` hsDeclName d2
 116 #else
 117 instance (Eq name) => Eq (HsDecl name pat) where
 118         d1 == d2 = hsDeclName d1 == hsDeclName d2
 119
 120 instance (Ord name) => Ord (HsDecl name pat) where
 121         d1 `compare` d2 = hsDeclName d1 `compare` hsDeclName d2
 122 #endif
 123 -}
 124 \end{code}
 125
 126
 127 %************************************************************************
 128 %*                                                                      *
 129 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
 130 %*                                                                      *
 131 %************************************************************************
 132
 133 \begin{code}
 134 data TyClDecl name pat
 135   = TyData      NewOrData
 136                 (Context name)  -- context
 137                 name            -- type constructor
 138                 [HsTyVar name]  -- type variables
 139                 [ConDecl name]  -- data constructors (empty if abstract)
 140                 (Maybe [name])  -- derivings; Nothing => not specified
 141                                 -- (i.e., derive default); Just [] => derive
 142                                 -- *nothing*; Just <list> => as you would
 143                                 -- expect...
 144                 (DataPragmas name)
 145                 SrcLoc
 146
 147   | TySynonym   name            -- type constructor
 148                 [HsTyVar name]  -- type variables
 149                 (HsType name)   -- synonym expansion
 150                 SrcLoc
 151
 152   | ClassDecl   (Context name)                  -- context...
 153                 name                            -- name of the class
 154                 [HsTyVar name]                  -- the class type variables
 155                 [Sig name]                      -- methods' signatures
 156                 (MonoBinds name pat)    -- default methods
 157                 (ClassPragmas name)
 158                 name name                       -- The names of the tycon and datacon for this class
 159                                                 -- These are filled in by the renamer
 160                 SrcLoc
 161 \end{code}
 162
 163 \begin{code}
 164 countTyClDecls :: [TyClDecl name pat] -> (Int, Int, Int, Int)
 165         -- class, data, newtype, synonym decls
 166 countTyClDecls decls
 167  = (length [() | ClassDecl _ _ _ _ _ _ _ _   _ <- decls],
 168     length [() | TyData DataType _ _ _ _ _ _ _ <- decls],
 169     length [() | TyData NewType  _ _ _ _ _ _ _ <- decls],
 170     length [() | TySynonym _ _ _ _             <- decls])
 171
 172 isDataDecl, isSynDecl, isClassDecl :: TyClDecl name pat -> Bool
 173
 174 isSynDecl (TySynonym _ _ _ _) = True
 175 isSynDecl other               = False
 176
 177 isDataDecl (TyData _ _ _ _ _ _ _ _) = True
 178 isDataDecl other                    = False
 179
 180 isClassDecl (ClassDecl _ _ _ _ _ _ _ _ _) = True
 181 isClassDecl other                         = False
 182 \end{code}
 183
 184 \begin{code}
 185 instance (Outputable name, Outputable pat)
 186               => Outputable (TyClDecl name pat) where
 187
 188     ppr (TySynonym tycon tyvars mono_ty src_loc)
 189       = hang (pp_decl_head SLIT("type") empty tycon tyvars)
 190              4 (ppr mono_ty)
 191
 192     ppr (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
 193       = pp_tydecl
 194                   (pp_decl_head keyword (pprContext context) tycon tyvars)
 195                   (pp_condecls condecls)
 196                   derivings
 197       where
 198         keyword = case new_or_data of
 199                         NewType  -> SLIT("newtype")
 200                         DataType -> SLIT("data")
 201
 202     ppr (ClassDecl context clas tyvars sigs methods pragmas _ _ src_loc)
 203       | null sigs       -- No "where" part
 204       = top_matter
 205
 206       | otherwise       -- Laid out
 207       = sep [hsep [top_matter, ptext SLIT("where {")],
 208                nest 4 (vcat [sep (map ppr_sig sigs),
 209                                    ppr methods,
 210                                    char '}'])]
 211       where
 212         top_matter = hsep [ptext SLIT("class"), pprContext context,
 213                             ppr clas, hsep (map (ppr) tyvars)]
 214         ppr_sig sig = ppr sig <> semi
 215
 216
 217 pp_decl_head str pp_context tycon tyvars
 218   = hsep [ptext str, pp_context, ppr tycon,
 219            interppSP tyvars, ptext SLIT("=")]
 220
 221 pp_condecls []     = empty              -- Curious!
 222 pp_condecls (c:cs) = sep (ppr c : map (\ c -> ptext SLIT("|") <+> ppr c) cs)
 223
 224 pp_tydecl pp_head pp_decl_rhs derivings
 225   = hang pp_head 4 (sep [
 226         pp_decl_rhs,
 227         case derivings of
 228           Nothing          -> empty
 229           Just ds          -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
 230     ])
 231 \end{code}
 232
 233 A type for recording what types a datatype should be specialised to.
 234 It's called a ``Sig'' because it's sort of like a ``type signature''
 235 for an datatype declaration.
 236
 237 \begin{code}
 238 data SpecDataSig name
 239   = SpecDataSig name            -- tycon to specialise
 240                 (HsType name)
 241                 SrcLoc
 242
 243 instance (Outputable name)
 244               => Outputable (SpecDataSig name) where
 245
 246     ppr (SpecDataSig tycon ty _)
 247       = hsep [text "{-# SPECIALIZE data", ppr ty, text "#-}"]
 248 \end{code}
 249
 250 %************************************************************************
 251 %*                                                                      *
 252 \subsection[ConDecl]{A data-constructor declaration}
 253 %*                                                                      *
 254 %************************************************************************
 255
 256 \begin{code}
 257 data ConDecl name
 258   = ConDecl     name                    -- Constructor name
 259
 260                 [HsTyVar name]          -- Existentially quantified type variables
 261                 (Context name)          -- ...and context
 262                                         -- If both are empty then there are no existentials
 263
 264                 (ConDetails name)
 265                 SrcLoc
 266
 267 data ConDetails name
 268   = VanillaCon                  -- prefix-style con decl
 269                 [BangType name]
 270
 271   | InfixCon                    -- infix-style con decl
 272                 (BangType name)
 273                 (BangType name)
 274
 275   | RecCon                      -- record-style con decl
 276                 [([name], BangType name)]       -- list of "fields"
 277
 278   | NewCon                      -- newtype con decl, possibly with a labelled field.
 279                 (HsType name)
 280                 (Maybe name)    -- Just x => labelled field 'x'
 281
 282 data BangType name
 283   = Banged   (HsType name)      -- HsType: to allow Haskell extensions
 284   | Unbanged (HsType name)      -- (MonoType only needed for straight Haskell)
 285   | Unpacked (HsType name)      -- Field is strict and to be unpacked if poss.
 286 \end{code}
 287
 288 \begin{code}
 289 instance (Outputable name) => Outputable (ConDecl name) where
 290     ppr (ConDecl con tvs cxt con_details  loc)
 291       = sep [pprForAll tvs, pprContext cxt, ppr_con_details con con_details]
 292
 293 ppr_con_details con (InfixCon ty1 ty2)
 294   = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
 295
 296 ppr_con_details con (VanillaCon tys)
 297   = ppr con <+> hsep (map (ppr_bang) tys)
 298
 299 ppr_con_details con (NewCon ty Nothing)
 300   = ppr con <+> pprParendHsType ty
 301
 302 ppr_con_details con (NewCon ty (Just x))
 303   = ppr con <+> braces pp_field
 304    where
 305     pp_field = ppr x <+> dcolon <+> pprParendHsType ty
 306
 307 ppr_con_details con (RecCon fields)
 308   = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
 309   where
 310     ppr_field (ns, ty) = hsep (map (ppr) ns) <+>
 311                          dcolon <+>
 312                          ppr_bang ty
 313
 314 ppr_bang (Banged   ty) = ptext SLIT("!") <> pprParendHsType ty
 315 ppr_bang (Unbanged ty) = pprParendHsType ty
 316 ppr_bang (Unpacked ty) = ptext SLIT("! !") <> pprParendHsType ty
 317 \end{code}
 318
 319
 320 %************************************************************************
 321 %*                                                                      *
 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                                 -- Using a polytype means that the renamer conveniently
 330                                 -- figures out the quantified type variables for us.
 331
 332                 (MonoBinds name pat)
 333
 334                 [Sig name]              -- User-supplied pragmatic info
 335
 336                 (Maybe name)            -- Name for the dictionary function
 337
 338                 SrcLoc
 339 \end{code}
 340
 341 \begin{code}
 342 instance (Outputable name, Outputable pat)
 343               => Outputable (InstDecl name pat) where
 344
 345     ppr (InstDecl inst_ty binds uprags dfun_name src_loc)
 346       = getPprStyle $ \ sty ->
 347         if ifaceStyle sty || (nullMonoBinds binds && null uprags) then
 348            hsep [ptext SLIT("instance"), ppr inst_ty]
 349         else
 350            vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
 351                  nest 4 (ppr uprags),
 352                  nest 4 (ppr binds) ]
 353 \end{code}
 354
 355
 356 %************************************************************************
 357 %*                                                                      *
 358 \subsection[DefaultDecl]{A @default@ declaration}
 359 %*                                                                      *
 360 %************************************************************************
 361
 362 There can only be one default declaration per module, but it is hard
 363 for the parser to check that; we pass them all through in the abstract
 364 syntax, and that restriction must be checked in the front end.
 365
 366 \begin{code}
 367 data DefaultDecl name
 368   = DefaultDecl [HsType name]
 369                 SrcLoc
 370
 371 instance (Outputable name)
 372               => Outputable (DefaultDecl name) where
 373
 374     ppr (DefaultDecl tys src_loc)
 375       = ptext SLIT("default") <+> parens (interpp'SP tys)
 376 \end{code}
 377
 378 %************************************************************************
 379 %*                                                                      *
 380 \subsection{Foreign function interface declaration}
 381 %*                                                                      *
 382 %************************************************************************
 383
 384 \begin{code}
 385 data ForeignDecl name =
 386    ForeignDecl
 387         name
 388         ForKind
 389         (HsType name)
 390         ExtName
 391         CallConv
 392         SrcLoc
 393
 394 instance (Outputable name)
 395               => Outputable (ForeignDecl name) where
 396
 397     ppr (ForeignDecl nm imp_exp ty ext_name cconv src_loc)
 398       = ptext SLIT("foreign") <+> ppr_imp_exp <+> pprCallConv cconv <+>
 399         ppr ext_name <+> ppr_unsafe <+> ppr nm <+> dcolon <+> ppr ty
 400         where
 401          (ppr_imp_exp, ppr_unsafe) =
 402            case imp_exp of
 403              FoLabel     -> (ptext SLIT("label"), empty)
 404              FoExport    -> (ptext SLIT("export"), empty)
 405              FoImport us
 406                 | us        -> (ptext SLIT("import"), ptext SLIT("unsafe"))
 407                 | otherwise -> (ptext SLIT("import"), empty)
 408
 409 data ForKind
 410  = FoLabel
 411  | FoExport
 412  | FoImport Bool -- True  => unsafe call.
 413
 414 data ExtName
 415  = Dynamic
 416  | ExtName FAST_STRING (Maybe FAST_STRING)
 417
 418 isDynamic :: ExtName -> Bool
 419 isDynamic Dynamic = True
 420 isDynamic _       = False
 421
 422
 423 instance Outputable ExtName where
 424   ppr Dynamic      = ptext SLIT("dynamic")
 425   ppr (ExtName nm mb_mod) =
 426      case mb_mod of { Nothing -> empty; Just m -> doubleQuotes (ptext m) } <+>
 427      doubleQuotes (ptext nm)
 428
 429 \end{code}
 430
 431 %************************************************************************
 432 %*                                                                      *
 433 \subsection{Signatures in interface files}
 434 %*                                                                      *
 435 %************************************************************************
 436
 437 \begin{code}
 438 data IfaceSig name
 439   = IfaceSig    name
 440                 (HsType name)
 441                 [HsIdInfo name]
 442                 SrcLoc
 443
 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 data HsIdInfo name
 450   = HsArity             ArityInfo
 451   | HsStrictness        (HsStrictnessInfo name)
 452   | HsUnfold            InlinePragInfo (Maybe (UfExpr name))
 453   | HsUpdate            UpdateInfo
 454   | HsSpecialise        [HsTyVar name] [HsType name] (UfExpr name)
 455   | HsNoCafRefs
 456   | HsCprInfo           CprInfo
 457
 458
 459 data HsStrictnessInfo name
 460   = HsStrictnessInfo ([Demand], Bool)
 461                      (Maybe (name, [name]))     -- Worker, if any
 462                                                 -- and needed constructors
 463   | HsBottom
 464 \end{code}