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