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