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 (n, ty) = ppCat [ppr sty n, ppPStr SLIT("::"), ppr_bang sty ty]
 253
 254 ppr_bang sty (Banged   ty) = ppBeside (ppChar '!') (pprParendHsType sty ty)
 255 ppr_bang sty (Unbanged ty) = pprParendHsType sty ty
 256 \end{code}
 257
 258 %************************************************************************
 259 %*                                                                      *
 260 \subsection[ClassDecl]{A class declaration}
 261 %*                                                                      *
 262 %************************************************************************
 263
 264 \begin{code}
 265 data ClassDecl tyvar uvar name pat
 266   = ClassDecl   (Context name)                  -- context...
 267                 name                            -- name of the class
 268                 (HsTyVar name)                  -- the class type variable
 269                 [Sig name]                      -- methods' signatures
 270                 (MonoBinds tyvar uvar name pat) -- default methods
 271                 (ClassPragmas name)
 272                 SrcLoc
 273 \end{code}
 274
 275 \begin{code}
 276 instance (NamedThing name, Outputable name, Outputable pat,
 277           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 278                 => Outputable (ClassDecl tyvar uvar name pat) where
 279
 280     ppr sty (ClassDecl context clas tyvar sigs methods pragmas src_loc)
 281       | null sigs       -- No "where" part
 282       = top_matter
 283
 284       | iface_style     -- All on one line (for now at least)
 285       = ppCat [top_matter, ppStr "where",
 286                ppCurlies (ppInterleave (ppPStr SLIT("; ")) pp_sigs)]
 287
 288       | otherwise       -- Laid out
 289       = ppSep [ppCat [top_matter, ppStr "where {"],
 290                ppNest 4 ((ppIntersperse ppSemi pp_sigs `ppAbove` pp_methods)
 291                          `ppBeside` ppStr "}")]
 292       where
 293         top_matter = ppCat [ppStr "class", pp_context_and_arrow sty context,
 294                             ppr sty (getOccName clas), ppr sty tyvar]
 295         pp_sigs     = map (ppr sty) sigs
 296         pp_methods  = ppr sty methods
 297         iface_style = case sty of {PprInterface -> True; other -> False}
 298 \end{code}
 299
 300 %************************************************************************
 301 %*                                                                      *
 302 \subsection[InstDecl]{An instance declaration (also, @SpecInstSig@)}
 303 %*                                                                      *
 304 %************************************************************************
 305
 306 \begin{code}
 307 data InstDecl tyvar uvar name pat
 308   = InstDecl    (HsType name)   -- Context => Class Instance-type
 309                                 -- Using a polytype means that the renamer conveniently
 310                                 -- figures out the quantified type variables for us.
 311
 312                 (MonoBinds tyvar uvar name pat)
 313
 314                 [Sig name]              -- User-supplied pragmatic info
 315
 316                 (Maybe name)            -- Name for the dictionary function
 317
 318                 SrcLoc
 319 \end{code}
 320
 321 \begin{code}
 322 instance (NamedThing name, Outputable name, Outputable pat,
 323           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 324               => Outputable (InstDecl tyvar uvar name pat) where
 325
 326     ppr sty (InstDecl inst_ty binds uprags dfun_name src_loc)
 327       | case sty of { PprInterface -> True; other -> False} ||
 328         nullMonoBinds binds && null uprags
 329       = ppCat [ppStr "instance", ppr sty inst_ty]
 330
 331       | otherwise
 332       = ppAboves [ppCat [ppStr "instance", ppr sty inst_ty, ppStr "where"],
 333                   ppNest 4 (ppr sty uprags),
 334                   ppNest 4 (ppr sty binds) ]
 335 \end{code}
 336
 337 A type for recording what instances the user wants to specialise;
 338 called a ``Sig'' because it's sort of like a ``type signature'' for an
 339 instance.
 340 \begin{code}
 341 data SpecInstSig name
 342   = SpecInstSig  name               -- class
 343                  (HsType name)    -- type to specialise to
 344                  SrcLoc
 345
 346 instance (NamedThing name, Outputable name)
 347               => Outputable (SpecInstSig name) where
 348
 349     ppr sty (SpecInstSig clas ty _)
 350       = ppCat [ppStr "{-# SPECIALIZE instance", ppr sty clas, ppr sty ty, ppStr "#-}"]
 351 \end{code}
 352
 353 %************************************************************************
 354 %*                                                                      *
 355 \subsection[DefaultDecl]{A @default@ declaration}
 356 %*                                                                      *
 357 %************************************************************************
 358
 359 There can only be one default declaration per module, but it is hard
 360 for the parser to check that; we pass them all through in the abstract
 361 syntax, and that restriction must be checked in the front end.
 362
 363 \begin{code}
 364 data DefaultDecl name
 365   = DefaultDecl [HsType name]
 366                 SrcLoc
 367
 368 instance (NamedThing name, Outputable name)
 369               => Outputable (DefaultDecl name) where
 370
 371     ppr sty (DefaultDecl tys src_loc)
 372       = ppBeside (ppPStr SLIT("default ")) (ppParens (interpp'SP sty tys))
 373 \end{code}
 374
 375 %************************************************************************
 376 %*                                                                      *
 377 \subsection{Signatures in interface files}
 378 %*                                                                      *
 379 %************************************************************************
 380
 381 \begin{code}
 382 data IfaceSig name
 383   = IfaceSig    name
 384                 (HsType name)
 385                 [HsIdInfo name]
 386                 SrcLoc
 387
 388 instance (NamedThing name, Outputable name) => Outputable (IfaceSig name) where
 389     ppr sty (IfaceSig var ty _ _)
 390       = ppHang (ppCat [ppr sty (getOccName var), ppPStr SLIT("::")])
 391              4 (ppr sty ty)
 392
 393 data HsIdInfo name
 394   = HsArity             ArityInfo
 395   | HsStrictness        (StrictnessInfo name)
 396   | HsUnfold            (UfExpr name)
 397   | HsUpdate            UpdateInfo
 398   | HsDeforest          DeforestInfo
 399   | HsArgUsage          ArgUsageInfo
 400   | HsFBType            FBTypeInfo
 401         -- ToDo: specialisations
 402 \end{code}