ghc/compiler/hsSyn/HsDecls.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[HsDecls]{Abstract syntax: global declarations}
   5
   6 Definitions for: @FixityDecl@, @TyDecl@ and @ConDecl@, @ClassDecl@,
   7 @InstDecl@, @DefaultDecl@.
   8
   9 \begin{code}
  10 #include "HsVersions.h"
  11
  12 module HsDecls where
  13
  14 IMP_Ubiq()
  15
  16 -- friends:
  17 import HsBinds          ( HsBinds, MonoBinds, Sig, nullMonoBinds )
  18 import HsPragmas        ( DataPragmas, ClassPragmas,
  19                           InstancePragmas, ClassOpPragmas
  20                         )
  21 import HsTypes
  22 import IdInfo
  23 import SpecEnv          ( SpecEnv )
  24 import HsCore           ( UfExpr )
  25 import HsBasic          ( Fixity )
  26
  27 -- others:
  28 import Name             ( pprSym, pprNonSym, getOccName, OccName )
  29 import Outputable       ( interppSP, interpp'SP,
  30                           Outputable(..){-instance * []-}
  31                         )
  32 import Pretty
  33 import SrcLoc           ( SrcLoc )
  34 import PprStyle         ( PprStyle(..), ifaceStyle )
  35 \end{code}
  36
  37
  38 %************************************************************************
  39 %*                                                                      *
  40 \subsection[HsDecl]{Declarations}
  41 %*                                                                      *
  42 %************************************************************************
  43
  44 \begin{code}
  45 data HsDecl tyvar uvar name pat
  46   = TyD         (TyDecl name)
  47   | ClD         (ClassDecl tyvar uvar name pat)
  48   | InstD       (InstDecl  tyvar uvar name pat)
  49   | DefD        (DefaultDecl name)
  50   | ValD        (HsBinds tyvar uvar name pat)
  51   | SigD        (IfaceSig name)
  52 \end{code}
  53
  54 \begin{code}
  55 hsDeclName (TyD (TyData _ name _ _ _ _ _))    = name
  56 hsDeclName (TyD (TyNew  _ name _ _ _ _ _))    = name
  57 hsDeclName (TyD (TySynonym name _ _ _))       = name
  58 hsDeclName (ClD (ClassDecl _ name _ _ _ _ _)) = name
  59 hsDeclName (SigD (IfaceSig name _ _ _))       = name
  60 -- Others don't make sense
  61 \end{code}
  62
  63 \begin{code}
  64 instance (NamedThing name, Outputable name, Outputable pat,
  65           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
  66         => Outputable (HsDecl tyvar uvar name pat) where
  67
  68     ppr sty (TyD td)     = ppr sty td
  69     ppr sty (ClD cd)     = ppr sty cd
  70     ppr sty (SigD sig)   = ppr sty sig
  71     ppr sty (ValD binds) = ppr sty binds
  72     ppr sty (DefD def)   = ppr sty def
  73     ppr sty (InstD inst) = ppr sty inst
  74
  75 -- In interfaces, top-level binders are printed without their "Module." prefix
  76 ppr_top_binder sty bndr | ifaceStyle sty = ppr sty (getOccName bndr)
  77                         | otherwise      = ppr sty bndr
  78 \end{code}
  79
  80
  81 %************************************************************************
  82 %*                                                                      *
  83 \subsection[FixityDecl]{A fixity declaration}
  84 %*                                                                      *
  85 %************************************************************************
  86
  87 \begin{code}
  88 data FixityDecl name  = FixityDecl name Fixity SrcLoc
  89
  90 instance Outputable name => Outputable (FixityDecl name) where
  91   ppr sty (FixityDecl name fixity loc) = ppSep [ppr sty fixity, ppr sty name]
  92 \end{code}
  93
  94
  95 %************************************************************************
  96 %*                                                                      *
  97 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
  98 %*                                                                      *
  99 %************************************************************************
 100
 101 \begin{code}
 102 data TyDecl name
 103   = TyData      (Context name)  -- context
 104                 name            -- type constructor
 105                 [HsTyVar name]  -- type variables
 106                 [ConDecl name]  -- data constructors (empty if abstract)
 107                 (Maybe [name])  -- derivings; Nothing => not specified
 108                                 -- (i.e., derive default); Just [] => derive
 109                                 -- *nothing*; Just <list> => as you would
 110                                 -- expect...
 111                 (DataPragmas name)
 112                 SrcLoc
 113
 114   | TyNew       (Context name)  -- context
 115                 name            -- type constructor
 116                 [HsTyVar name]  -- type variables
 117                 (ConDecl name)  -- data constructor
 118                 (Maybe [name])  -- derivings; as above
 119                 (DataPragmas name)
 120                 SrcLoc
 121
 122   | TySynonym   name            -- type constructor
 123                 [HsTyVar name]  -- type variables
 124                 (HsType name)   -- synonym expansion
 125                 SrcLoc
 126
 127 \end{code}
 128
 129 \begin{code}
 130 instance (NamedThing name, Outputable name)
 131               => Outputable (TyDecl name) where
 132
 133     ppr sty (TySynonym tycon tyvars mono_ty src_loc)
 134       = ppHang (pp_decl_head sty SLIT("type") ppNil tycon tyvars)
 135              4 (ppr sty mono_ty)
 136
 137     ppr sty (TyData context tycon tyvars condecls derivings pragmas src_loc)
 138       = pp_tydecl sty
 139                   (pp_decl_head sty SLIT("data") (pp_context_and_arrow sty context) tycon tyvars)
 140                   (pp_condecls sty condecls)
 141                   derivings
 142
 143     ppr sty (TyNew context tycon tyvars condecl derivings pragmas src_loc)
 144       = pp_tydecl sty
 145                   (pp_decl_head sty SLIT("newtype") (pp_context_and_arrow sty context) tycon tyvars)
 146                   (ppr sty condecl)
 147                   derivings
 148
 149 pp_decl_head sty str pp_context tycon tyvars
 150   = ppCat [ppPStr str, pp_context, ppr_top_binder sty tycon,
 151            interppSP sty tyvars, ppPStr SLIT("=")]
 152
 153 pp_condecls sty [] = ppNil              -- Curious!
 154 pp_condecls sty (c:cs)
 155   = ppSep (ppr sty c : map (\ c -> ppBeside (ppPStr SLIT("| ")) (ppr sty c)) cs)
 156
 157 pp_tydecl sty pp_head pp_decl_rhs derivings
 158   = ppHang pp_head 4 (ppSep [
 159         pp_decl_rhs,
 160         case (derivings, sty) of
 161           (Nothing,_)      -> ppNil
 162           (_,PprInterface) -> ppNil     -- No derivings in interfaces
 163           (Just ds,_)      -> ppCat [ppPStr SLIT("deriving"), ppParens (interpp'SP sty ds)]
 164     ])
 165
 166 pp_context_and_arrow :: Outputable name => PprStyle -> Context name -> Pretty
 167 pp_context_and_arrow sty [] = ppNil
 168 pp_context_and_arrow sty theta = ppCat [pprContext sty theta, ppPStr SLIT("=>")]
 169 \end{code}
 170
 171 A type for recording what types a datatype should be specialised to.
 172 It's called a ``Sig'' because it's sort of like a ``type signature''
 173 for an datatype declaration.
 174
 175 \begin{code}
 176 data SpecDataSig name
 177   = SpecDataSig name            -- tycon to specialise
 178                 (HsType name)
 179                 SrcLoc
 180
 181 instance (NamedThing name, Outputable name)
 182               => Outputable (SpecDataSig name) where
 183
 184     ppr sty (SpecDataSig tycon ty _)
 185       = ppCat [ppStr "{-# SPECIALIZE data", ppr sty ty, ppStr "#-}"]
 186 \end{code}
 187
 188 %************************************************************************
 189 %*                                                                      *
 190 \subsection[ConDecl]{A data-constructor declaration}
 191 %*                                                                      *
 192 %************************************************************************
 193
 194 \begin{code}
 195 data ConDecl name
 196   = ConDecl     name            -- prefix-style con decl
 197                 [BangType name]
 198                 SrcLoc
 199
 200   | ConOpDecl   (BangType name) -- infix-style con decl
 201                 name
 202                 (BangType name)
 203                 SrcLoc
 204
 205   | RecConDecl  name
 206                 [([name], BangType name)]       -- list of "fields"
 207                 SrcLoc
 208
 209   | NewConDecl  name            -- newtype con decl
 210                 (HsType name)
 211                 SrcLoc
 212
 213 data BangType name
 214   = Banged   (HsType name)      -- HsType: to allow Haskell extensions
 215   | Unbanged (HsType name)      -- (MonoType only needed for straight Haskell)
 216 \end{code}
 217
 218 \begin{code}
 219 instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where
 220
 221     ppr sty (ConDecl con tys _)
 222       = ppCat [ppr_top_binder sty con, ppInterleave ppNil (map (ppr_bang sty) tys)]
 223
 224         -- We print ConOpDecls in prefix form in interface files
 225     ppr sty (ConOpDecl ty1 op ty2 _)
 226       | ifaceStyle sty
 227       = ppCat [ppr_top_binder sty op, ppr_bang sty ty1, ppr_bang sty ty2]
 228       | otherwise
 229       = ppCat [ppr_bang sty ty1, ppr_top_binder sty op, ppr_bang sty ty2]
 230
 231     ppr sty (NewConDecl con ty _)
 232       = ppCat [ppr_top_binder sty con, pprParendHsType sty ty]
 233     ppr sty (RecConDecl con fields _)
 234       = ppCat [ppr_top_binder sty con,
 235                ppCurlies (ppInterleave pp'SP (map pp_field fields))
 236               ]
 237       where
 238         pp_field (ns, ty) = ppCat [ppCat (map (ppr_top_binder sty) ns),
 239                                    ppPStr SLIT("::"), ppr_bang sty ty]
 240
 241 ppr_bang sty (Banged   ty) = ppBeside (ppPStr SLIT("! ")) (pprParendHsType sty ty)
 242                                 -- The extra space helps the lexical analyser that lexes
 243                                 -- interface files; it doesn't make the rigid operator/identifier
 244                                 -- distinction, so "!a" is a valid identifier so far as it is concerned
 245 ppr_bang sty (Unbanged ty) = pprParendHsType sty ty
 246 \end{code}
 247
 248 %************************************************************************
 249 %*                                                                      *
 250 \subsection[ClassDecl]{A class declaration}
 251 %*                                                                      *
 252 %************************************************************************
 253
 254 \begin{code}
 255 data ClassDecl tyvar uvar name pat
 256   = ClassDecl   (Context name)                  -- context...
 257                 name                            -- name of the class
 258                 (HsTyVar name)                  -- the class type variable
 259                 [Sig name]                      -- methods' signatures
 260                 (MonoBinds tyvar uvar name pat) -- default methods
 261                 (ClassPragmas name)
 262                 SrcLoc
 263 \end{code}
 264
 265 \begin{code}
 266 instance (NamedThing name, Outputable name, Outputable pat,
 267           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 268                 => Outputable (ClassDecl tyvar uvar name pat) where
 269
 270     ppr sty (ClassDecl context clas tyvar sigs methods pragmas src_loc)
 271       | null sigs       -- No "where" part
 272       = top_matter
 273
 274       | iface_style     -- All on one line (for now at least)
 275       = ppCat [top_matter, ppPStr SLIT("where"),
 276                ppCurlies (ppInterleave (ppPStr SLIT("; ")) pp_sigs)]
 277
 278       | otherwise       -- Laid out
 279       = ppSep [ppCat [top_matter, ppPStr SLIT("where {")],
 280                ppNest 4 ((ppIntersperse ppSemi pp_sigs `ppAbove` pp_methods)
 281                          `ppBeside` ppChar '}')]
 282       where
 283         top_matter = ppCat [ppPStr SLIT("class"), pp_context_and_arrow sty context,
 284                             ppr_top_binder sty clas, ppr sty tyvar]
 285         pp_sigs     = map (ppr sty) sigs
 286         pp_methods  = ppr sty methods
 287         iface_style = case sty of {PprInterface -> True; other -> False}
 288 \end{code}
 289
 290 %************************************************************************
 291 %*                                                                      *
 292 \subsection[InstDecl]{An instance declaration (also, @SpecInstSig@)}
 293 %*                                                                      *
 294 %************************************************************************
 295
 296 \begin{code}
 297 data InstDecl tyvar uvar name pat
 298   = InstDecl    (HsType name)   -- Context => Class Instance-type
 299                                 -- Using a polytype means that the renamer conveniently
 300                                 -- figures out the quantified type variables for us.
 301
 302                 (MonoBinds tyvar uvar name pat)
 303
 304                 [Sig name]              -- User-supplied pragmatic info
 305
 306                 (Maybe name)            -- Name for the dictionary function
 307
 308                 SrcLoc
 309 \end{code}
 310
 311 \begin{code}
 312 instance (NamedThing name, Outputable name, Outputable pat,
 313           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 314               => Outputable (InstDecl tyvar uvar name pat) where
 315
 316     ppr sty (InstDecl inst_ty binds uprags dfun_name src_loc)
 317       | case sty of { PprInterface -> True; other -> False} ||
 318         nullMonoBinds binds && null uprags
 319       = ppCat [ppPStr SLIT("instance"), ppr sty inst_ty]
 320
 321       | otherwise
 322       = ppAboves [ppCat [ppPStr SLIT("instance"), ppr sty inst_ty, ppPStr SLIT("where")],
 323                   ppNest 4 (ppr sty uprags),
 324                   ppNest 4 (ppr sty binds) ]
 325 \end{code}
 326
 327 A type for recording what instances the user wants to specialise;
 328 called a ``Sig'' because it's sort of like a ``type signature'' for an
 329 instance.
 330 \begin{code}
 331 data SpecInstSig name
 332   = SpecInstSig  name               -- class
 333                  (HsType name)    -- type to specialise to
 334                  SrcLoc
 335
 336 instance (NamedThing name, Outputable name)
 337               => Outputable (SpecInstSig name) where
 338
 339     ppr sty (SpecInstSig clas ty _)
 340       = ppCat [ppStr "{-# SPECIALIZE instance", ppr sty clas, ppr sty ty, ppStr "#-}"]
 341 \end{code}
 342
 343 %************************************************************************
 344 %*                                                                      *
 345 \subsection[DefaultDecl]{A @default@ declaration}
 346 %*                                                                      *
 347 %************************************************************************
 348
 349 There can only be one default declaration per module, but it is hard
 350 for the parser to check that; we pass them all through in the abstract
 351 syntax, and that restriction must be checked in the front end.
 352
 353 \begin{code}
 354 data DefaultDecl name
 355   = DefaultDecl [HsType name]
 356                 SrcLoc
 357
 358 instance (NamedThing name, Outputable name)
 359               => Outputable (DefaultDecl name) where
 360
 361     ppr sty (DefaultDecl tys src_loc)
 362       = ppBeside (ppPStr SLIT("default ")) (ppParens (interpp'SP sty tys))
 363 \end{code}
 364
 365 %************************************************************************
 366 %*                                                                      *
 367 \subsection{Signatures in interface files}
 368 %*                                                                      *
 369 %************************************************************************
 370
 371 \begin{code}
 372 data IfaceSig name
 373   = IfaceSig    name
 374                 (HsType name)
 375                 [HsIdInfo name]
 376                 SrcLoc
 377
 378 instance (NamedThing name, Outputable name) => Outputable (IfaceSig name) where
 379     ppr sty (IfaceSig var ty _ _)
 380       = ppHang (ppCat [ppr_top_binder sty var, ppPStr SLIT("::")])
 381              4 (ppr sty ty)
 382
 383 data HsIdInfo name
 384   = HsArity             ArityInfo
 385   | HsStrictness        (StrictnessInfo name)
 386   | HsUnfold            (UfExpr name)
 387   | HsUpdate            UpdateInfo
 388   | HsDeforest          DeforestInfo
 389   | HsArgUsage          ArgUsageInfo
 390   | HsFBType            FBTypeInfo
 391         -- ToDo: specialisations
 392 \end{code}