ghc/compiler/hsSyn/HsDecls.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[HsDecls]{Abstract syntax: global declarations}
   5
   6 Definitions for: @TyDecl@ and @ConDecl@, @ClassDecl@,
   7 @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
   8
   9 \begin{code}
  10 module HsDecls (
  11         HsDecl(..), TyClDecl(..), InstDecl(..), RuleDecl(..), RuleBndr(..),
  12         DefaultDecl(..), ForeignDecl(..), ForKind(..),
  13         ExtName(..), isDynamic,
  14         ConDecl(..), ConDetails(..), BangType(..),
  15         IfaceSig(..),  SpecDataSig(..),
  16         hsDeclName, tyClDeclName, isClassDecl, isSynDecl, isDataDecl, countTyClDecls
  17     ) where
  18
  19 #include "HsVersions.h"
  20
  21 -- friends:
  22 import HsBinds          ( HsBinds, MonoBinds, Sig, FixitySig(..), nullMonoBinds )
  23 import HsExpr           ( HsExpr )
  24 import HsPragmas        ( DataPragmas, ClassPragmas )
  25 import HsTypes
  26 import HsCore           ( UfExpr, UfBinder, IfaceSig(..), UfRuleBody )
  27 import BasicTypes       ( Fixity, NewOrData(..) )
  28 import CallConv         ( CallConv, pprCallConv )
  29 import Var              ( TyVar )
  30
  31 -- others:
  32 import PprType
  33 import Outputable
  34 import SrcLoc           ( SrcLoc )
  35 import Util
  36 \end{code}
  37
  38
  39 %************************************************************************
  40 %*                                                                      *
  41 \subsection[HsDecl]{Declarations}
  42 %*                                                                      *
  43 %************************************************************************
  44
  45 \begin{code}
  46 data HsDecl name pat
  47   = TyClD       (TyClDecl name pat)
  48   | InstD       (InstDecl  name pat)
  49   | DefD        (DefaultDecl name)
  50   | ValD        (HsBinds name pat)
  51   | ForD        (ForeignDecl name)
  52   | SigD        (IfaceSig name)
  53   | FixD        (FixitySig name)
  54   | RuleD       (RuleDecl name pat)
  55
  56 -- NB: all top-level fixity decls are contained EITHER
  57 -- EITHER FixDs
  58 -- OR     in the ClassDecls in TyClDs
  59 --
  60 -- The former covers
  61 --      a) data constructors
  62 --      b) class methods (but they can be also done in the
  63 --              signatures of class decls)
  64 --      c) imported functions (that have an IfacSig)
  65 --      d) top level decls
  66 --
  67 -- The latter is for class methods only
  68 \end{code}
  69
  70 \begin{code}
  71 #ifdef DEBUG
  72 hsDeclName :: (Outputable name, Outputable pat)
  73            => HsDecl name pat -> name
  74 #endif
  75 hsDeclName (TyClD decl)                          = tyClDeclName decl
  76 hsDeclName (SigD  (IfaceSig name _ _ _))         = name
  77 hsDeclName (InstD (InstDecl _ _ _ name _))       = name
  78 hsDeclName (ForD  (ForeignDecl name _ _ _ _ _))  = name
  79 hsDeclName (FixD  (FixitySig name _ _))          = name
  80 -- Others don't make sense
  81 #ifdef DEBUG
  82 hsDeclName x                                  = pprPanic "HsDecls.hsDeclName" (ppr x)
  83 #endif
  84
  85 tyClDeclName :: TyClDecl name pat -> name
  86 tyClDeclName (TyData _ _ name _ _ _ _ _)        = name
  87 tyClDeclName (TySynonym name _ _ _)             = name
  88 tyClDeclName (ClassDecl _ name _ _ _ _ _ _ _ _) = name
  89 \end{code}
  90
  91 \begin{code}
  92 instance (Outputable name, Outputable pat)
  93         => Outputable (HsDecl name pat) where
  94
  95     ppr (TyClD dcl)  = ppr dcl
  96     ppr (SigD sig)   = ppr sig
  97     ppr (ValD binds) = ppr binds
  98     ppr (DefD def)   = ppr def
  99     ppr (InstD inst) = ppr inst
 100     ppr (ForD fd)    = ppr fd
 101     ppr (FixD fd)    = ppr fd
 102     ppr (RuleD rd)   = ppr rd
 103 \end{code}
 104
 105
 106 %************************************************************************
 107 %*                                                                      *
 108 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
 109 %*                                                                      *
 110 %************************************************************************
 111
 112 \begin{code}
 113 data TyClDecl name pat
 114   = TyData      NewOrData
 115                 (Context name)  -- context
 116                 name            -- type constructor
 117                 [HsTyVar name]  -- type variables
 118                 [ConDecl name]  -- data constructors (empty if abstract)
 119                 (Maybe [name])  -- derivings; Nothing => not specified
 120                                 -- (i.e., derive default); Just [] => derive
 121                                 -- *nothing*; Just <list> => as you would
 122                                 -- expect...
 123                 (DataPragmas name)
 124                 SrcLoc
 125
 126   | TySynonym   name            -- type constructor
 127                 [HsTyVar name]  -- type variables
 128                 (HsType name)   -- synonym expansion
 129                 SrcLoc
 130
 131   | ClassDecl   (Context name)          -- context...
 132                 name                    -- name of the class
 133                 [HsTyVar name]          -- the class type variables
 134                 [Sig name]              -- methods' signatures
 135                 (MonoBinds name pat)    -- default methods
 136                 (ClassPragmas name)
 137                 name name [name]        -- The names of the tycon, datacon, and superclass selectors
 138                                         -- for this class.  These are filled in as the ClassDecl is made.
 139                 SrcLoc
 140 \end{code}
 141
 142 \begin{code}
 143 countTyClDecls :: [TyClDecl name pat] -> (Int, Int, Int, Int)
 144         -- class, data, newtype, synonym decls
 145 countTyClDecls decls
 146  = (length [() | ClassDecl _ _ _ _ _ _ _ _ _ _ <- decls],
 147     length [() | TyData DataType _ _ _ _ _ _ _ <- decls],
 148     length [() | TyData NewType  _ _ _ _ _ _ _ <- decls],
 149     length [() | TySynonym _ _ _ _             <- decls])
 150
 151 isDataDecl, isSynDecl, isClassDecl :: TyClDecl name pat -> Bool
 152
 153 isSynDecl (TySynonym _ _ _ _) = True
 154 isSynDecl other               = False
 155
 156 isDataDecl (TyData _ _ _ _ _ _ _ _) = True
 157 isDataDecl other                    = False
 158
 159 isClassDecl (ClassDecl _ _ _ _ _ _ _ _ _ _) = True
 160 isClassDecl other                           = False
 161 \end{code}
 162
 163 \begin{code}
 164 instance (Outputable name, Outputable pat)
 165               => Outputable (TyClDecl name pat) where
 166
 167     ppr (TySynonym tycon tyvars mono_ty src_loc)
 168       = hang (pp_decl_head SLIT("type") empty tycon tyvars)
 169              4 (ppr mono_ty)
 170
 171     ppr (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
 172       = pp_tydecl
 173                   (pp_decl_head keyword (pprContext context) tycon tyvars)
 174                   (pp_condecls condecls)
 175                   derivings
 176       where
 177         keyword = case new_or_data of
 178                         NewType  -> SLIT("newtype")
 179                         DataType -> SLIT("data")
 180
 181     ppr (ClassDecl context clas tyvars sigs methods pragmas _ _ _ src_loc)
 182       | null sigs       -- No "where" part
 183       = top_matter
 184
 185       | otherwise       -- Laid out
 186       = sep [hsep [top_matter, ptext SLIT("where {")],
 187                nest 4 (vcat [sep (map ppr_sig sigs),
 188                                    ppr methods,
 189                                    char '}'])]
 190       where
 191         top_matter = hsep [ptext SLIT("class"), pprContext context,
 192                             ppr clas, hsep (map (ppr) tyvars)]
 193         ppr_sig sig = ppr sig <> semi
 194
 195
 196 pp_decl_head str pp_context tycon tyvars
 197   = hsep [ptext str, pp_context, ppr tycon,
 198            interppSP tyvars, ptext SLIT("=")]
 199
 200 pp_condecls []     = empty              -- Curious!
 201 pp_condecls (c:cs) = sep (ppr c : map (\ c -> ptext SLIT("|") <+> ppr c) cs)
 202
 203 pp_tydecl pp_head pp_decl_rhs derivings
 204   = hang pp_head 4 (sep [
 205         pp_decl_rhs,
 206         case derivings of
 207           Nothing          -> empty
 208           Just ds          -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
 209     ])
 210 \end{code}
 211
 212 A type for recording what types a datatype should be specialised to.
 213 It's called a ``Sig'' because it's sort of like a ``type signature''
 214 for an datatype declaration.
 215
 216 \begin{code}
 217 data SpecDataSig name
 218   = SpecDataSig name            -- tycon to specialise
 219                 (HsType name)
 220                 SrcLoc
 221
 222 instance (Outputable name)
 223               => Outputable (SpecDataSig name) where
 224
 225     ppr (SpecDataSig tycon ty _)
 226       = hsep [text "{-# SPECIALIZE data", ppr ty, text "#-}"]
 227 \end{code}
 228
 229 %************************************************************************
 230 %*                                                                      *
 231 \subsection[ConDecl]{A data-constructor declaration}
 232 %*                                                                      *
 233 %************************************************************************
 234
 235 \begin{code}
 236 data ConDecl name
 237   = ConDecl     name                    -- Constructor name
 238
 239                 [HsTyVar name]          -- Existentially quantified type variables
 240                 (Context name)          -- ...and context
 241                                         -- If both are empty then there are no existentials
 242
 243                 (ConDetails name)
 244                 SrcLoc
 245
 246 data ConDetails name
 247   = VanillaCon                  -- prefix-style con decl
 248                 [BangType name]
 249
 250   | InfixCon                    -- infix-style con decl
 251                 (BangType name)
 252                 (BangType name)
 253
 254   | RecCon                      -- record-style con decl
 255                 [([name], BangType name)]       -- list of "fields"
 256
 257   | NewCon                      -- newtype con decl, possibly with a labelled field.
 258                 (HsType name)
 259                 (Maybe name)    -- Just x => labelled field 'x'
 260
 261 data BangType name
 262   = Banged   (HsType name)      -- HsType: to allow Haskell extensions
 263   | Unbanged (HsType name)      -- (MonoType only needed for straight Haskell)
 264   | Unpacked (HsType name)      -- Field is strict and to be unpacked if poss.
 265 \end{code}
 266
 267 \begin{code}
 268 instance (Outputable name) => Outputable (ConDecl name) where
 269     ppr (ConDecl con tvs cxt con_details  loc)
 270       = sep [pprForAll tvs, pprContext cxt, ppr_con_details con con_details]
 271
 272 ppr_con_details con (InfixCon ty1 ty2)
 273   = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
 274
 275 ppr_con_details con (VanillaCon tys)
 276   = ppr con <+> hsep (map (ppr_bang) tys)
 277
 278 ppr_con_details con (NewCon ty Nothing)
 279   = ppr con <+> pprParendHsType ty
 280
 281 ppr_con_details con (NewCon ty (Just x))
 282   = ppr con <+> braces pp_field
 283    where
 284     pp_field = ppr x <+> dcolon <+> pprParendHsType ty
 285
 286 ppr_con_details con (RecCon fields)
 287   = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
 288   where
 289     ppr_field (ns, ty) = hsep (map (ppr) ns) <+>
 290                          dcolon <+>
 291                          ppr_bang ty
 292
 293 ppr_bang (Banged   ty) = ptext SLIT("!") <> pprParendHsType ty
 294 ppr_bang (Unbanged ty) = pprParendHsType ty
 295 ppr_bang (Unpacked ty) = ptext SLIT("! !") <> pprParendHsType ty
 296 \end{code}
 297
 298
 299 %************************************************************************
 300 %*                                                                      *
 301 \subsection[InstDecl]{An instance declaration
 302 %*                                                                      *
 303 %************************************************************************
 304
 305 \begin{code}
 306 data InstDecl name pat
 307   = InstDecl    (HsType name)   -- Context => Class Instance-type
 308                                 -- Using a polytype means that the renamer conveniently
 309                                 -- figures out the quantified type variables for us.
 310
 311                 (MonoBinds name pat)
 312
 313                 [Sig name]              -- User-supplied pragmatic info
 314
 315                 name                    -- Name for the dictionary function
 316
 317                 SrcLoc
 318 \end{code}
 319
 320 \begin{code}
 321 instance (Outputable name, Outputable pat)
 322               => Outputable (InstDecl name pat) where
 323
 324     ppr (InstDecl inst_ty binds uprags dfun_name src_loc)
 325       = getPprStyle $ \ sty ->
 326         if ifaceStyle sty || (nullMonoBinds binds && null uprags) then
 327            hsep [ptext SLIT("instance"), ppr inst_ty]
 328         else
 329            vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
 330                  nest 4 (ppr uprags),
 331                  nest 4 (ppr binds) ]
 332 \end{code}
 333
 334
 335 %************************************************************************
 336 %*                                                                      *
 337 \subsection[DefaultDecl]{A @default@ declaration}
 338 %*                                                                      *
 339 %************************************************************************
 340
 341 There can only be one default declaration per module, but it is hard
 342 for the parser to check that; we pass them all through in the abstract
 343 syntax, and that restriction must be checked in the front end.
 344
 345 \begin{code}
 346 data DefaultDecl name
 347   = DefaultDecl [HsType name]
 348                 SrcLoc
 349
 350 instance (Outputable name)
 351               => Outputable (DefaultDecl name) where
 352
 353     ppr (DefaultDecl tys src_loc)
 354       = ptext SLIT("default") <+> parens (interpp'SP tys)
 355 \end{code}
 356
 357 %************************************************************************
 358 %*                                                                      *
 359 \subsection{Foreign function interface declaration}
 360 %*                                                                      *
 361 %************************************************************************
 362
 363 \begin{code}
 364 data ForeignDecl name =
 365    ForeignDecl
 366         name
 367         ForKind
 368         (HsType name)
 369         ExtName
 370         CallConv
 371         SrcLoc
 372
 373 instance (Outputable name)
 374               => Outputable (ForeignDecl name) where
 375
 376     ppr (ForeignDecl nm imp_exp ty ext_name cconv src_loc)
 377       = ptext SLIT("foreign") <+> ppr_imp_exp <+> pprCallConv cconv <+>
 378         ppr ext_name <+> ppr_unsafe <+> ppr nm <+> dcolon <+> ppr ty
 379         where
 380          (ppr_imp_exp, ppr_unsafe) =
 381            case imp_exp of
 382              FoLabel     -> (ptext SLIT("label"), empty)
 383              FoExport    -> (ptext SLIT("export"), empty)
 384              FoImport us
 385                 | us        -> (ptext SLIT("import"), ptext SLIT("unsafe"))
 386                 | otherwise -> (ptext SLIT("import"), empty)
 387
 388 data ForKind
 389  = FoLabel
 390  | FoExport
 391  | FoImport Bool -- True  => unsafe call.
 392
 393 data ExtName
 394  = Dynamic
 395  | ExtName FAST_STRING (Maybe FAST_STRING)
 396
 397 isDynamic :: ExtName -> Bool
 398 isDynamic Dynamic = True
 399 isDynamic _       = False
 400
 401
 402 instance Outputable ExtName where
 403   ppr Dynamic      = ptext SLIT("dynamic")
 404   ppr (ExtName nm mb_mod) =
 405      case mb_mod of { Nothing -> empty; Just m -> doubleQuotes (ptext m) } <+>
 406      doubleQuotes (ptext nm)
 407
 408 \end{code}
 409
 410 %************************************************************************
 411 %*                                                                      *
 412 \subsection{Transformation rules}
 413 %*                                                                      *
 414 %************************************************************************
 415
 416 \begin{code}
 417 data RuleDecl name pat
 418   = RuleDecl
 419         FAST_STRING             -- Rule name
 420         [name]                  -- Forall'd tyvars, filled in by the renamer with
 421                                 -- tyvars mentioned in sigs; then filled out by typechecker
 422         [RuleBndr name]         -- Forall'd term vars
 423         (HsExpr name pat)       -- LHS
 424         (HsExpr name pat)       -- RHS
 425         SrcLoc
 426
 427   | IfaceRuleDecl               -- One that's come in from an interface file
 428         name
 429         (UfRuleBody name)
 430         SrcLoc
 431
 432 data RuleBndr name
 433   = RuleBndr name
 434   | RuleBndrSig name (HsType name)
 435
 436 instance (Outputable name, Outputable pat)
 437               => Outputable (RuleDecl name pat) where
 438   ppr (RuleDecl name tvs ns lhs rhs loc)
 439         = text "RULE" <+> doubleQuotes (ptext name) <> colon <+>
 440           sep [pp_forall, ppr lhs, equals <+> ppr rhs]
 441         where
 442           pp_forall | null tvs && null ns = empty
 443                     | otherwise           = text "forall" <+>
 444                                             fsep (map ppr tvs ++ map ppr ns)
 445                                             <> dot
 446   ppr (IfaceRuleDecl var body loc) = text "An imported rule..."
 447
 448 instance Outputable name => Outputable (RuleBndr name) where
 449    ppr (RuleBndr name) = ppr name
 450    ppr (RuleBndrSig name ty) = ppr name <> dcolon <> ppr ty
 451 \end{code}