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 import Ubiq
  15
  16 -- friends:
  17 import HsLoop           ( nullMonoBinds, MonoBinds, Sig )
  18 import HsPragmas        ( DataPragmas, ClassPragmas,
  19                           InstancePragmas, ClassOpPragmas )
  20 import HsTypes
  21
  22 -- others:
  23 import Name             ( pprSym, pprNonSym )
  24 import Outputable       ( interppSP, interpp'SP,
  25                           Outputable(..){-instance * []-}
  26                         )
  27 import Pretty
  28 import SrcLoc           ( SrcLoc )
  29 import Util             ( cmpList, panic#{-ToDo:rm eventually-} )
  30 \end{code}
  31
  32 %************************************************************************
  33 %*                                                                      *
  34 \subsection[FixityDecl]{A fixity declaration}
  35 %*                                                                      *
  36 %************************************************************************
  37
  38 \begin{code}
  39 data FixityDecl name
  40   = InfixL      name Int
  41   | InfixR      name Int
  42   | InfixN      name Int
  43 \end{code}
  44
  45 \begin{code}
  46 instance (NamedThing name, Outputable name)
  47      => Outputable (FixityDecl name) where
  48     ppr sty (InfixL var prec)   = print_it sty "l" prec var
  49     ppr sty (InfixR var prec)   = print_it sty "r" prec var
  50     ppr sty (InfixN var prec)   = print_it sty ""  prec var
  51
  52 print_it sty suff prec var
  53   = ppBesides [ppStr "infix", ppStr suff, ppSP, ppInt prec, ppSP, pprSym sty var]
  54 \end{code}
  55
  56 %************************************************************************
  57 %*                                                                      *
  58 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
  59 %*                                                                      *
  60 %************************************************************************
  61
  62 \begin{code}
  63 data TyDecl name
  64   = TyData      (Context name)  -- context
  65                 name            -- type constructor
  66                 [name]          -- type variables
  67                 [ConDecl name]  -- data constructors (empty if abstract)
  68                 (Maybe [name])  -- derivings; Nothing => not specified
  69                                 -- (i.e., derive default); Just [] => derive
  70                                 -- *nothing*; Just <list> => as you would
  71                                 -- expect...
  72                 (DataPragmas name)
  73                 SrcLoc
  74
  75   | TyNew       (Context name)  -- context
  76                 name            -- type constructor
  77                 [name]          -- type variables
  78                 [ConDecl name]  -- data constructor (empty if abstract)
  79                 (Maybe [name])  -- derivings; as above
  80                 (DataPragmas name)
  81                 SrcLoc
  82
  83   | TySynonym   name            -- type constructor
  84                 [name]          -- type variables
  85                 (MonoType name) -- synonym expansion
  86                 SrcLoc
  87
  88 \end{code}
  89
  90 \begin{code}
  91 instance (NamedThing name, Outputable name)
  92               => Outputable (TyDecl name) where
  93
  94     ppr sty (TySynonym tycon tyvars mono_ty src_loc)
  95       = ppHang (pp_decl_head sty SLIT("type") ppNil tycon tyvars)
  96              4 (ppCat [ppEquals, ppr sty mono_ty])
  97
  98     ppr sty (TyData context tycon tyvars condecls derivings pragmas src_loc)
  99       = pp_tydecl sty
 100                   (pp_decl_head sty SLIT("data") (pprContext sty context) tycon tyvars)
 101                   (pp_condecls sty condecls)
 102                   derivings
 103
 104     ppr sty (TyNew context tycon tyvars condecl derivings pragmas src_loc)
 105       = pp_tydecl sty
 106                   (pp_decl_head sty SLIT("newtype") (pprContext sty context) tycon tyvars)
 107                   (pp_condecls sty condecl)
 108                   derivings
 109
 110 pp_decl_head sty str pp_context tycon tyvars
 111   = ppCat [ppPStr str, pp_context, ppr sty tycon, interppSP sty tyvars]
 112
 113 pp_condecls sty [] = ppNil -- abstract datatype
 114 pp_condecls sty (c:cs)
 115   = ppSep (ppBeside (ppStr "= ") (ppr sty c)
 116            : map (\ x -> ppBeside (ppStr "| ") (ppr sty x)) cs)
 117
 118 pp_tydecl sty pp_head pp_decl_rhs derivings
 119   = ppHang pp_head 4 (ppSep [
 120         pp_decl_rhs,
 121         case derivings of
 122           Nothing -> ppNil
 123           Just ds -> ppBeside (ppPStr SLIT("deriving "))
 124                         (ppParens (ppInterleave ppComma (map (ppr sty) ds)))])
 125 \end{code}
 126
 127 A type for recording what types a datatype should be specialised to.
 128 It's called a ``Sig'' because it's sort of like a ``type signature''
 129 for an datatype declaration.
 130
 131 \begin{code}
 132 data SpecDataSig name
 133   = SpecDataSig name            -- tycon to specialise
 134                 (MonoType name)
 135                 SrcLoc
 136
 137 instance (NamedThing name, Outputable name)
 138               => Outputable (SpecDataSig name) where
 139
 140     ppr sty (SpecDataSig tycon ty _)
 141       = ppCat [ppStr "{-# SPECIALIZE data", ppr sty ty, ppStr "#-}"]
 142 \end{code}
 143
 144 %************************************************************************
 145 %*                                                                      *
 146 \subsection[ConDecl]{A data-constructor declaration}
 147 %*                                                                      *
 148 %************************************************************************
 149
 150 \begin{code}
 151 data ConDecl name
 152   = ConDecl     name            -- prefix-style con decl
 153                 [BangType name]
 154                 SrcLoc
 155
 156   | ConOpDecl   (BangType name) -- infix-style con decl
 157                 name
 158                 (BangType name)
 159                 SrcLoc
 160
 161   | RecConDecl  name
 162                 [([name], BangType name)]       -- list of "fields"
 163                 SrcLoc
 164
 165   | NewConDecl  name            -- newtype con decl
 166                 (MonoType name)
 167                 SrcLoc
 168
 169 data BangType name
 170   = Banged   (MonoType name)
 171   | Unbanged (MonoType name)
 172 \end{code}
 173
 174 \begin{code}
 175 instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where
 176
 177     ppr sty (ConDecl con tys _)
 178       = ppCat [pprNonSym sty con, ppInterleave ppNil (map (ppr_bang sty) tys)]
 179     ppr sty (ConOpDecl ty1 op ty2 _)
 180       = ppCat [ppr_bang sty ty1, pprSym sty op, ppr_bang sty ty2]
 181     ppr sty (NewConDecl con ty _)
 182       = ppCat [pprNonSym sty con, pprParendMonoType sty ty]
 183     ppr sty (RecConDecl con fields _)
 184       = ppCat [pprNonSym sty con, ppChar '{',
 185                ppInterleave pp'SP (map pp_field fields), ppChar '}']
 186       where
 187         pp_field (n, ty) = ppCat [ppr sty n, ppPStr SLIT("::"), ppr_bang sty ty]
 188
 189 ppr_bang sty (Banged   ty) = ppBeside (ppChar '!') (pprParendMonoType sty ty)
 190 ppr_bang sty (Unbanged ty) = pprParendMonoType sty ty
 191 \end{code}
 192
 193 %************************************************************************
 194 %*                                                                      *
 195 \subsection[ClassDecl]{A class declaration}
 196 %*                                                                      *
 197 %************************************************************************
 198
 199 \begin{code}
 200 data ClassDecl tyvar uvar name pat
 201   = ClassDecl   (Context name)                  -- context...
 202                 name                            -- name of the class
 203                 name                            -- the class type variable
 204                 [Sig name]                      -- methods' signatures
 205                 (MonoBinds tyvar uvar name pat) -- default methods
 206                 (ClassPragmas name)
 207                 SrcLoc
 208 \end{code}
 209
 210 \begin{code}
 211 instance (NamedThing name, Outputable name, Outputable pat,
 212           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 213                 => Outputable (ClassDecl tyvar uvar name pat) where
 214
 215     ppr sty (ClassDecl context clas tyvar sigs methods pragmas src_loc)
 216      = let
 217            top_matter = ppCat [ppStr "class", pprContext sty context,
 218                                ppr sty clas, ppr sty tyvar]
 219        in
 220        if null sigs && nullMonoBinds methods then
 221            ppAbove top_matter (ppNest 4 (ppr sty pragmas))
 222        else
 223            ppAboves [ppCat [top_matter, ppStr "where"],
 224                      ppNest 4 (ppAboves (map (ppr sty) sigs)),
 225                      ppNest 4 (ppr sty methods),
 226                      ppNest 4 (ppr sty pragmas) ]
 227 \end{code}
 228
 229 %************************************************************************
 230 %*                                                                      *
 231 \subsection[InstDecl]{An instance declaration (also, @SpecInstSig@)}
 232 %*                                                                      *
 233 %************************************************************************
 234
 235 \begin{code}
 236 data InstDecl tyvar uvar name pat
 237   = InstDecl    name            -- Class
 238
 239                 (PolyType name) -- Context => Instance-type
 240                                 -- Using a polytype means that the renamer conveniently
 241                                 -- figures out the quantified type variables for us.
 242
 243                 (MonoBinds tyvar uvar name pat)
 244
 245                 Bool            -- True <=> This instance decl is from the
 246                                 -- module being compiled; False <=> It is from
 247                                 -- an imported interface.
 248
 249                 (Maybe Module)  -- The name of the module where the instance decl
 250                                 -- originally came from; Nothing => Prelude
 251
 252                 [Sig name]              -- actually user-supplied pragmatic info
 253                 (InstancePragmas name)  -- interface-supplied pragmatic info
 254                 SrcLoc
 255 \end{code}
 256
 257 \begin{code}
 258 instance (NamedThing name, Outputable name, Outputable pat,
 259           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
 260               => Outputable (InstDecl tyvar uvar name pat) where
 261
 262     ppr sty (InstDecl clas ty binds local modname uprags pragmas src_loc)
 263       = let
 264             (context, inst_ty)
 265               = case ty of
 266                   HsPreForAllTy c t -> (c, t)
 267                   HsForAllTy  _ c t -> (c, t)
 268
 269             top_matter = ppCat [ppStr "instance", pprContext sty context,
 270                                 ppr sty clas, pprParendMonoType sty inst_ty]
 271         in
 272         if nullMonoBinds binds && null uprags then
 273             ppAbove top_matter (ppNest 4 (ppr sty pragmas))
 274         else
 275             ppAboves [ppCat [top_matter, ppStr "where"],
 276                       if null uprags then ppNil else ppNest 4 (ppr sty uprags),
 277                       ppNest 4 (ppr sty binds),
 278                       ppNest 4 (ppr sty pragmas) ]
 279 \end{code}
 280
 281 A type for recording what instances the user wants to specialise;
 282 called a ``Sig'' because it's sort of like a ``type signature'' for an
 283 instance.
 284 \begin{code}
 285 data SpecInstSig name
 286   = SpecInstSig  name               -- class
 287                  (MonoType name)    -- type to specialise to
 288                  SrcLoc
 289
 290 instance (NamedThing name, Outputable name)
 291               => Outputable (SpecInstSig name) where
 292
 293     ppr sty (SpecInstSig clas ty _)
 294       = ppCat [ppStr "{-# SPECIALIZE instance", ppr sty clas, ppr sty ty, ppStr "#-}"]
 295 \end{code}
 296
 297 %************************************************************************
 298 %*                                                                      *
 299 \subsection[DefaultDecl]{A @default@ declaration}
 300 %*                                                                      *
 301 %************************************************************************
 302
 303 There can only be one default declaration per module, but it is hard
 304 for the parser to check that; we pass them all through in the abstract
 305 syntax, and that restriction must be checked in the front end.
 306
 307 \begin{code}
 308 data DefaultDecl name
 309   = DefaultDecl [MonoType name]
 310                 SrcLoc
 311
 312 instance (NamedThing name, Outputable name)
 313               => Outputable (DefaultDecl name) where
 314
 315     ppr sty (DefaultDecl tys src_loc)
 316       = ppBeside (ppPStr SLIT("default ")) (ppParens (interpp'SP sty tys))
 317 \end{code}