ghc/compiler/abstractSyn/HsDecls.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   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 HsBinds          ( nullMonoBinds, ProtoNameMonoBinds(..),
  15                           MonoBinds, Sig
  16                         )
  17 import HsPat            ( ProtoNamePat(..), RenamedPat(..), InPat )
  18 import HsPragmas        ( DataPragmas, TypePragmas, ClassPragmas,
  19                           InstancePragmas, ClassOpPragmas
  20                         )
  21 import HsTypes
  22 import Id               ( Id )
  23 import Name             ( Name )
  24 import Outputable
  25 import Pretty
  26 import ProtoName        ( cmpProtoName, ProtoName(..) ) -- .. for pragmas only
  27 import SrcLoc           ( SrcLoc )
  28 import Unique           ( Unique )
  29 import Util
  30 \end{code}
  31
  32 %************************************************************************
  33 %*                                                                      *
  34 \subsection[FixityDecl]{A fixity declaration}
  35 %*                                                                      *
  36 %************************************************************************
  37
  38 These are only used in generating interfaces at the moment.  They are
  39 not used in pretty-printing.
  40
  41 \begin{code}
  42 data FixityDecl name
  43   = InfixL          name Int
  44   | InfixR          name Int
  45   | InfixN          name Int
  46
  47 type ProtoNameFixityDecl = FixityDecl ProtoName
  48 type RenamedFixityDecl   = FixityDecl Name
  49 \end{code}
  50
  51 \begin{code}
  52 instance (NamedThing name, Outputable name)
  53      => Outputable (FixityDecl name) where
  54     ppr sty (InfixL var prec)   = ppCat [ppStr "infixl", ppInt prec, pprOp sty var]
  55     ppr sty (InfixR var prec)   = ppCat [ppStr "infixr", ppInt prec, pprOp sty var]
  56     ppr sty (InfixN var prec)   = ppCat [ppStr "infix ", ppInt prec, pprOp sty var]
  57 \end{code}
  58
  59 %************************************************************************
  60 %*                                                                      *
  61 \subsection[TyDecl]{An algebraic datatype or type-synonym declaration (plus @DataTypeSig@...)}
  62 %*                                                                      *
  63 %************************************************************************
  64
  65 \begin{code}
  66 data TyDecl name
  67   = TyData      (Context name)  -- context (not used yet)
  68                 name            -- type constructor
  69                 [name]          -- type variables
  70                 [ConDecl name]  -- data constructors
  71                 [name]          -- derivings
  72                 (DataPragmas name)
  73                 SrcLoc
  74
  75   | TySynonym   name            -- type constructor
  76                 [name]          -- type variables
  77                 (MonoType name) -- synonym expansion
  78                 TypePragmas
  79                 SrcLoc
  80
  81 type ProtoNameTyDecl = TyDecl ProtoName
  82 type RenamedTyDecl   = TyDecl Name
  83 \end{code}
  84
  85 \begin{code}
  86 instance (NamedThing name, Outputable name)
  87               => Outputable (TyDecl name) where
  88
  89     ppr sty (TyData context tycon tyvars condecls derivings pragmas src_loc)
  90      = ppAbove (ifPprShowAll sty (ppr sty src_loc)) -- ToDo: pragmas
  91         (ppHang (ppCat [ppStr "data", pprContext sty context, ppr sty tycon, interppSP sty tyvars])
  92                4
  93                (ppSep [
  94                 ppr sty condecls,
  95                 if (null derivings) then
  96                     ppNil
  97                 else
  98                     ppBesides [ppStr "deriving (", interpp'SP sty derivings, ppStr ")"]]))
  99
 100     ppr sty (TySynonym tycon tyvars mono_ty pragmas src_loc)
 101      = ppHang (ppCat [ppStr "type", ppr sty tycon, interppSP sty tyvars])
 102               4 (ppCat [ppEquals, ppr sty mono_ty,
 103                         ifPprShowAll sty (ppr sty src_loc)]) -- ToDo: pragmas
 104 \end{code}
 105
 106 A type for recording what type synonyms the user wants treated as {\em
 107 abstract} types.  It's called a ``Sig'' because it's sort of like a
 108 ``type signature'' for an synonym declaration.
 109
 110 Note: the Right Way to do this abstraction game is for the language to
 111 support it.
 112 \begin{code}
 113 data DataTypeSig name
 114   = AbstractTypeSig name        -- tycon to abstract-ify
 115                     SrcLoc
 116   | SpecDataSig name            -- tycon to specialise
 117                 (MonoType name)
 118                 SrcLoc
 119
 120
 121 type ProtoNameDataTypeSig = DataTypeSig ProtoName
 122 type RenamedDataTypeSig   = DataTypeSig Name
 123
 124 instance (NamedThing name, Outputable name)
 125               => Outputable (DataTypeSig name) where
 126
 127     ppr sty (AbstractTypeSig tycon _)
 128       = ppCat [ppStr "{-# ABSTRACT", ppr sty tycon, ppStr "#-}"]
 129
 130     ppr sty (SpecDataSig tycon ty _)
 131       = ppCat [ppStr "{-# SPECIALSIE data", ppr sty ty, ppStr "#-}"]
 132 \end{code}
 133
 134 %************************************************************************
 135 %*                                                                      *
 136 \subsection[ConDecl]{A data-constructor declaration}
 137 %*                                                                      *
 138 %************************************************************************
 139
 140 A data constructor for an algebraic data type.
 141
 142 \begin{code}
 143 data ConDecl name = ConDecl name [MonoType name] SrcLoc
 144
 145 type ProtoNameConDecl = ConDecl ProtoName
 146 type RenamedConDecl   = ConDecl Name
 147 \end{code}
 148
 149 In checking interfaces, we need to ``compare'' @ConDecls@.  Use with care!
 150 \begin{code}
 151 eqConDecls cons1 cons2
 152   = case (cmpList cmp cons1 cons2) of { EQ_ -> True; _ -> False }
 153   where
 154     cmp (ConDecl n1 tys1 _) (ConDecl n2 tys2 _)
 155       = case cmpProtoName n1 n2 of
 156           EQ_ -> cmpList (cmpMonoType cmpProtoName) tys1 tys2
 157           xxx -> xxx
 158 \end{code}
 159
 160 \begin{code}
 161 instance (NamedThing name, Outputable name) => Outputable (ConDecl name) where
 162
 163     ppr sty (ConDecl con mono_tys src_loc)
 164       = ppCat [pprNonOp sty con,
 165                ppInterleave ppNil (map (pprParendMonoType sty) mono_tys)]
 166 \end{code}
 167
 168 %************************************************************************
 169 %*                                                                      *
 170 \subsection[ClassDecl]{A class declaration}
 171 %*                                                                      *
 172 %************************************************************************
 173
 174 \begin{code}
 175 data ClassDecl name pat
 176   = ClassDecl   (Context name)          -- context...
 177                 name                    -- name of the class
 178                 name                    -- the class type variable
 179                 [Sig name]              -- methods' signatures
 180                 (MonoBinds name pat)    -- default methods
 181                 (ClassPragmas name)
 182                 SrcLoc
 183
 184 type ProtoNameClassDecl = ClassDecl ProtoName ProtoNamePat
 185 type RenamedClassDecl   = ClassDecl Name      RenamedPat
 186 \end{code}
 187
 188 \begin{code}
 189 instance (NamedThing name, Outputable name,
 190           NamedThing pat, Outputable pat)
 191                 => Outputable (ClassDecl name pat) where
 192
 193     ppr sty (ClassDecl context clas tyvar sigs methods pragmas src_loc)
 194      = ppAboves [ppCat [ppStr "class", pprContext sty context, ppr sty clas,
 195                         ppr sty tyvar, ppStr "where"],
 196                         -- ToDo: really shouldn't print "where" unless there are sigs
 197                  ppNest 4 (ppAboves (map (ppr sty) sigs)),
 198                  ppNest 4 (ppr sty methods),
 199                  ppNest 4 (ppr sty pragmas)]
 200 \end{code}
 201
 202 %************************************************************************
 203 %*                                                                      *
 204 \subsection[InstDecl]{An instance declaration (also, @SpecialisedInstanceSig@)}
 205 %*                                                                      *
 206 %************************************************************************
 207
 208 \begin{code}
 209 data InstDecl name pat
 210   = InstDecl    (Context name)
 211                 name                 -- class
 212                 (MonoType name)
 213                 (MonoBinds name pat)
 214                 Bool    -- True <=> This instance decl is from the
 215                         -- module being compiled; False <=> It is from
 216                         -- an imported interface.
 217
 218                 FAST_STRING{-ModuleName-}
 219                         -- The module where the instance decl
 220                         -- originally came from; easy enough if it's
 221                         -- the module being compiled; otherwise, the
 222                         -- info comes from a pragma.
 223
 224                 FAST_STRING
 225                         -- Name of the module who told us about this
 226                         -- inst decl (the `informer') ToDo: listify???
 227
 228                 [Sig name]              -- actually user-supplied pragmatic info
 229                 (InstancePragmas name)  -- interface-supplied pragmatic info
 230                 SrcLoc
 231
 232 type ProtoNameInstDecl = InstDecl ProtoName ProtoNamePat
 233 type RenamedInstDecl   = InstDecl Name      RenamedPat
 234 \end{code}
 235
 236 \begin{code}
 237 instance (NamedThing name, Outputable name,
 238           NamedThing pat, Outputable pat)
 239               => Outputable (InstDecl name pat) where
 240
 241     ppr sty (InstDecl context clas ty binds local modname imod uprags pragmas src_loc)
 242       = let
 243             top_matter = ppCat [ppStr "instance", pprContext sty context, ppr sty clas, ppr sty ty]
 244         in
 245         if nullMonoBinds binds && null uprags then
 246             ppAbove top_matter (ppNest 4 (ppr sty pragmas))
 247         else
 248             ppAboves [
 249               ppCat [top_matter, ppStr "where"],
 250               ppNest 4 (ppr sty uprags),
 251               ppNest 4 (ppr sty binds),
 252               ppNest 4 (ppr sty pragmas) ]
 253 \end{code}
 254
 255 A type for recording what instances the user wants to specialise;
 256 called a ``Sig'' because it's sort of like a ``type signature'' for an
 257 instance.
 258 \begin{code}
 259 data SpecialisedInstanceSig name
 260   = InstSpecSig  name               -- class
 261                  (MonoType name)    -- type to specialise to
 262                  SrcLoc
 263
 264 type ProtoNameSpecialisedInstanceSig = SpecialisedInstanceSig ProtoName
 265 type RenamedSpecialisedInstanceSig   = SpecialisedInstanceSig Name
 266
 267 instance (NamedThing name, Outputable name)
 268               => Outputable (SpecialisedInstanceSig name) where
 269
 270     ppr sty (InstSpecSig clas ty _)
 271       = ppCat [ppStr "{-# SPECIALIZE instance", ppr sty clas, ppr sty ty, ppStr "#-}"]
 272 \end{code}
 273
 274 %************************************************************************
 275 %*                                                                      *
 276 \subsection[DefaultDecl]{A @default@ declaration}
 277 %*                                                                      *
 278 %************************************************************************
 279
 280 There can only be one default declaration per module, but it is hard
 281 for the parser to check that; we pass them all through in the abstract
 282 syntax, and that restriction must be checked in the front end.
 283
 284 \begin{code}
 285 data DefaultDecl name
 286   = DefaultDecl [MonoType name]
 287                 SrcLoc
 288
 289 type ProtoNameDefaultDecl = DefaultDecl ProtoName
 290 type RenamedDefaultDecl   = DefaultDecl Name
 291 \end{code}
 292
 293 \begin{code}
 294 instance (NamedThing name, Outputable name)
 295               => Outputable (DefaultDecl name) where
 296
 297     ppr sty (DefaultDecl tys src_loc)
 298       = ppBesides [ppStr "default (", interpp'SP sty tys, ppStr ")"]
 299 \end{code}