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: @FixityDecl@, @TyDecl@ and @ConDecl@, @ClassDecl@,
   7 @InstDecl@, @DefaultDecl@ and @ForeignDecl@.
   8
   9 \begin{code}
  10 module HsDecls where
  11
  12 #include "HsVersions.h"
  13
  14 -- friends:
  15 import HsBinds          ( HsBinds, MonoBinds, Sig, nullMonoBinds )
  16 import HsPragmas        ( DataPragmas, ClassPragmas )
  17 import HsTypes
  18 import HsCore           ( UfExpr )
  19 import BasicTypes       ( Fixity, NewOrData(..) )
  20 import IdInfo           ( ArityInfo, UpdateInfo, InlinePragInfo )
  21 import Demand           ( Demand )
  22 import CallConv         ( CallConv, pprCallConv )
  23
  24 -- others:
  25 import Name             ( NamedThing )
  26 import Outputable
  27 import SrcLoc           ( SrcLoc )
  28 import Util
  29 \end{code}
  30
  31
  32 %************************************************************************
  33 %*                                                                      *
  34 \subsection[HsDecl]{Declarations}
  35 %*                                                                      *
  36 %************************************************************************
  37
  38 \begin{code}
  39 data HsDecl flexi name pat
  40   = TyD         (TyDecl name)
  41   | ClD         (ClassDecl flexi name pat)
  42   | InstD       (InstDecl  flexi name pat)
  43   | DefD        (DefaultDecl name)
  44   | ValD        (HsBinds flexi name pat)
  45   | SigD        (IfaceSig name)
  46   | ForD        (ForeignDecl name)
  47 \end{code}
  48
  49 \begin{code}
  50 #ifdef DEBUG
  51 hsDeclName :: (NamedThing name, Outputable name, Outputable pat)
  52            => HsDecl flexi name pat -> name
  53 #endif
  54 hsDeclName (TyD (TyData _ _ name _ _ _ _ _))      = name
  55 hsDeclName (TyD (TySynonym name _ _ _))           = name
  56 hsDeclName (ClD (ClassDecl _ name _ _ _ _ _ _ _)) = name
  57 hsDeclName (SigD (IfaceSig name _ _ _))           = name
  58 hsDeclName (InstD (InstDecl _ _ _ (Just name) _)) = name
  59 hsDeclName (ForD  (ForeignDecl name _ _ _ _ _))   = name
  60 -- Others don't make sense
  61 #ifdef DEBUG
  62 hsDeclName x                                  = pprPanic "HsDecls.hsDeclName" (ppr x)
  63 #endif
  64 \end{code}
  65
  66 \begin{code}
  67 instance (NamedThing name, Outputable name, Outputable pat)
  68         => Outputable (HsDecl flexi name pat) where
  69
  70     ppr (TyD td)     = ppr td
  71     ppr (ClD cd)     = ppr cd
  72     ppr (SigD sig)   = ppr sig
  73     ppr (ValD binds) = ppr binds
  74     ppr (DefD def)   = ppr def
  75     ppr (InstD inst) = ppr inst
  76     ppr (ForD fd)    = ppr fd
  77
  78 #ifdef DEBUG
  79 -- hsDeclName needs more context when DEBUG is on
  80 instance (NamedThing name, Outputable name, Outputable pat, Eq name)
  81       => Eq (HsDecl flex name pat) where
  82    d1 == d2 = hsDeclName d1 == hsDeclName d2
  83
  84 instance (NamedThing name, Outputable name, Outputable pat, Ord name)
  85       => Ord (HsDecl flex name pat) where
  86         d1 `compare` d2 = hsDeclName d1 `compare` hsDeclName d2
  87 #else
  88 instance (Eq name) => Eq (HsDecl flex name pat) where
  89         d1 == d2 = hsDeclName d1 == hsDeclName d2
  90
  91 instance (Ord name) => Ord (HsDecl flexi name pat) where
  92         d1 `compare` d2 = hsDeclName d1 `compare` hsDeclName d2
  93 #endif
  94 \end{code}
  95
  96
  97 %************************************************************************
  98 %*                                                                      *
  99 \subsection[FixityDecl]{A fixity declaration}
 100 %*                                                                      *
 101 %************************************************************************
 102
 103 \begin{code}
 104 data FixityDecl name  = FixityDecl name Fixity SrcLoc
 105
 106 instance Outputable name => Outputable (FixityDecl name) where
 107   ppr (FixityDecl name fixity loc) = sep [ppr fixity, ppr name]
 108 \end{code}
 109
 110
 111 %************************************************************************
 112 %*                                                                      *
 113 \subsection[TyDecl]{@data@, @newtype@ or @type@ (synonym) type declaration}
 114 %*                                                                      *
 115 %************************************************************************
 116
 117 \begin{code}
 118 data TyDecl name
 119   = TyData      NewOrData
 120                 (Context name)  -- context
 121                 name            -- type constructor
 122                 [HsTyVar name]  -- type variables
 123                 [ConDecl name]  -- data constructors (empty if abstract)
 124                 (Maybe [name])  -- derivings; Nothing => not specified
 125                                 -- (i.e., derive default); Just [] => derive
 126                                 -- *nothing*; Just <list> => as you would
 127                                 -- expect...
 128                 (DataPragmas name)
 129                 SrcLoc
 130
 131   | TySynonym   name            -- type constructor
 132                 [HsTyVar name]  -- type variables
 133                 (HsType name)   -- synonym expansion
 134                 SrcLoc
 135
 136 \end{code}
 137
 138 \begin{code}
 139 instance (NamedThing name, Outputable name)
 140               => Outputable (TyDecl name) where
 141
 142     ppr (TySynonym tycon tyvars mono_ty src_loc)
 143       = hang (pp_decl_head SLIT("type") empty tycon tyvars)
 144              4 (ppr mono_ty)
 145
 146     ppr (TyData new_or_data context tycon tyvars condecls derivings pragmas src_loc)
 147       = pp_tydecl
 148                   (pp_decl_head keyword (pprContext context) tycon tyvars)
 149                   (pp_condecls condecls)
 150                   derivings
 151       where
 152         keyword = case new_or_data of
 153                         NewType  -> SLIT("newtype")
 154                         DataType -> SLIT("data")
 155
 156 pp_decl_head str pp_context tycon tyvars
 157   = hsep [ptext str, pp_context, ppr tycon,
 158            interppSP tyvars, ptext SLIT("=")]
 159
 160 pp_condecls [] = empty          -- Curious!
 161 pp_condecls (c:cs)
 162   = sep (ppr c : map (\ c -> (<>) (ptext SLIT("| ")) (ppr c)) cs)
 163
 164 pp_tydecl pp_head pp_decl_rhs derivings
 165   = hang pp_head 4 (sep [
 166         pp_decl_rhs,
 167         case derivings of
 168           Nothing          -> empty
 169           Just ds          -> hsep [ptext SLIT("deriving"), parens (interpp'SP ds)]
 170     ])
 171 \end{code}
 172
 173 A type for recording what types a datatype should be specialised to.
 174 It's called a ``Sig'' because it's sort of like a ``type signature''
 175 for an datatype declaration.
 176
 177 \begin{code}
 178 data SpecDataSig name
 179   = SpecDataSig name            -- tycon to specialise
 180                 (HsType name)
 181                 SrcLoc
 182
 183 instance (NamedThing name, Outputable name)
 184               => Outputable (SpecDataSig name) where
 185
 186     ppr (SpecDataSig tycon ty _)
 187       = hsep [text "{-# SPECIALIZE data", ppr ty, text "#-}"]
 188 \end{code}
 189
 190 %************************************************************************
 191 %*                                                                      *
 192 \subsection[ConDecl]{A data-constructor declaration}
 193 %*                                                                      *
 194 %************************************************************************
 195
 196 \begin{code}
 197 data ConDecl name
 198   = ConDecl     name                    -- Constructor name
 199
 200                 [HsTyVar name]          -- Existentially quantified type variables
 201                 (Context name)          -- ...and context
 202                                         -- If both are empty then there are no existentials
 203
 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 (ConDecl con tvs cxt con_details  loc)
 229       = sep [pprForAll tvs, pprContext cxt, ppr_con_details con con_details]
 230
 231 ppr_con_details con (InfixCon ty1 ty2)
 232   = hsep [ppr_bang ty1, ppr con, ppr_bang ty2]
 233
 234 ppr_con_details con (VanillaCon tys)
 235   = ppr con <+> hsep (map (ppr_bang) tys)
 236
 237 ppr_con_details con (NewCon ty)
 238   = ppr con <+> pprParendHsType ty
 239
 240 ppr_con_details con (RecCon fields)
 241   = ppr con <+> braces (hsep (punctuate comma (map ppr_field fields)))
 242   where
 243     ppr_field (ns, ty) = hsep (map (ppr) ns) <+>
 244                          ptext SLIT("::") <+>
 245                          ppr_bang ty
 246
 247 ppr_bang (Banged   ty) = ptext SLIT("!") <> pprParendHsType ty
 248 ppr_bang (Unbanged ty) = pprParendHsType ty
 249 \end{code}
 250
 251 %************************************************************************
 252 %*                                                                      *
 253 \subsection[ClassDecl]{A class declaration}
 254 %*                                                                      *
 255 %************************************************************************
 256
 257 \begin{code}
 258 data ClassDecl flexi name pat
 259   = ClassDecl   (Context name)                  -- context...
 260                 name                            -- name of the class
 261                 [HsTyVar name]                  -- the class type variables
 262                 [Sig name]                      -- methods' signatures
 263                 (MonoBinds flexi name pat)      -- default methods
 264                 (ClassPragmas name)
 265                 name name                       -- The names of the tycon and datacon for this class
 266                                                 -- These are filled in by the renamer
 267                 SrcLoc
 268 \end{code}
 269
 270 \begin{code}
 271 instance (NamedThing name, Outputable name, Outputable pat)
 272                 => Outputable (ClassDecl flexi name pat) where
 273
 274     ppr (ClassDecl context clas tyvars sigs methods pragmas _ _ src_loc)
 275       | null sigs       -- No "where" part
 276       = top_matter
 277
 278       | otherwise       -- Laid out
 279       = sep [hsep [top_matter, ptext SLIT("where {")],
 280                nest 4 (vcat [sep (map ppr_sig sigs),
 281                                    ppr methods,
 282                                    char '}'])]
 283       where
 284         top_matter = hsep [ptext SLIT("class"), pprContext context,
 285                             ppr clas, hsep (map (ppr) tyvars)]
 286         ppr_sig sig = ppr sig <> semi
 287 \end{code}
 288
 289 %************************************************************************
 290 %*                                                                      *
 291 \subsection[InstDecl]{An instance declaration
 292 %*                                                                      *
 293 %************************************************************************
 294
 295 \begin{code}
 296 data InstDecl flexi name pat
 297   = InstDecl    (HsType name)   -- Context => Class Instance-type
 298                                 -- Using a polytype means that the renamer conveniently
 299                                 -- figures out the quantified type variables for us.
 300
 301                 (MonoBinds flexi name pat)
 302
 303                 [Sig name]              -- User-supplied pragmatic info
 304
 305                 (Maybe name)            -- Name for the dictionary function
 306
 307                 SrcLoc
 308 \end{code}
 309
 310 \begin{code}
 311 instance (NamedThing name, Outputable name, Outputable pat)
 312               => Outputable (InstDecl flexi name pat) where
 313
 314     ppr (InstDecl inst_ty binds uprags dfun_name src_loc)
 315       = getPprStyle $ \ sty ->
 316         if ifaceStyle sty || (nullMonoBinds binds && null uprags) then
 317            hsep [ptext SLIT("instance"), ppr inst_ty]
 318         else
 319            vcat [hsep [ptext SLIT("instance"), ppr inst_ty, ptext SLIT("where")],
 320                  nest 4 (ppr uprags),
 321                  nest 4 (ppr binds) ]
 322 \end{code}
 323
 324
 325 %************************************************************************
 326 %*                                                                      *
 327 \subsection[DefaultDecl]{A @default@ declaration}
 328 %*                                                                      *
 329 %************************************************************************
 330
 331 There can only be one default declaration per module, but it is hard
 332 for the parser to check that; we pass them all through in the abstract
 333 syntax, and that restriction must be checked in the front end.
 334
 335 \begin{code}
 336 data DefaultDecl name
 337   = DefaultDecl [HsType name]
 338                 SrcLoc
 339
 340 instance (NamedThing name, Outputable name)
 341               => Outputable (DefaultDecl name) where
 342
 343     ppr (DefaultDecl tys src_loc)
 344       = ptext SLIT("default") <+> parens (interpp'SP tys)
 345 \end{code}
 346
 347 %************************************************************************
 348 %*                                                                      *
 349 \subsection{Foreign function interface declaration}
 350 %*                                                                      *
 351 %************************************************************************
 352
 353 \begin{code}
 354 data ForeignDecl name =
 355    ForeignDecl
 356         name
 357         ForKind
 358         (HsType name)
 359         ExtName
 360         CallConv
 361         SrcLoc
 362
 363 instance (NamedThing name, Outputable name)
 364               => Outputable (ForeignDecl name) where
 365
 366     ppr (ForeignDecl nm imp_exp ty ext_name cconv src_loc)
 367       = ptext SLIT("foreign") <+> ppr_imp_exp <+> pprCallConv cconv <+>
 368         ppr ext_name <+> ppr_unsafe <+> ppr nm <+> ptext SLIT("::")  <+> ppr ty
 369         where
 370          (ppr_imp_exp, ppr_unsafe) =
 371            case imp_exp of
 372              FoLabel     -> (ptext SLIT("label"), empty)
 373              FoExport    -> (ptext SLIT("export"), empty)
 374              FoImport us
 375                 | us        -> (ptext SLIT("import"), ptext SLIT("unsafe"))
 376                 | otherwise -> (ptext SLIT("import"), empty)
 377
 378 data ForKind
 379  = FoLabel
 380  | FoExport
 381  | FoImport Bool -- True  => unsafe call.
 382
 383 data ExtName
 384  = Dynamic
 385  | ExtName FAST_STRING (Maybe FAST_STRING)
 386
 387 isDynamic :: ExtName -> Bool
 388 isDynamic Dynamic = True
 389 isDynamic _       = False
 390
 391
 392 instance Outputable ExtName where
 393   ppr Dynamic      = ptext SLIT("dynamic")
 394   ppr (ExtName nm mb_mod) =
 395      case mb_mod of { Nothing -> empty; Just m -> doubleQuotes (ptext m) } <+>
 396      doubleQuotes (ptext nm)
 397
 398 \end{code}
 399
 400 %************************************************************************
 401 %*                                                                      *
 402 \subsection{Signatures in interface files}
 403 %*                                                                      *
 404 %************************************************************************
 405
 406 \begin{code}
 407 data IfaceSig name
 408   = IfaceSig    name
 409                 (HsType name)
 410                 [HsIdInfo name]
 411                 SrcLoc
 412
 413 instance (NamedThing name, Outputable name) => Outputable (IfaceSig name) where
 414     ppr (IfaceSig var ty _ _)
 415       = hang (hsep [ppr var, ptext SLIT("::")])
 416              4 (ppr ty)
 417
 418 data HsIdInfo name
 419   = HsArity             ArityInfo
 420   | HsStrictness        (HsStrictnessInfo name)
 421   | HsUnfold            InlinePragInfo (Maybe (UfExpr name))
 422   | HsUpdate            UpdateInfo
 423   | HsSpecialise        [HsTyVar name] [HsType name] (UfExpr name)
 424   | HsNoCafRefs
 425
 426
 427 data HsStrictnessInfo name
 428   = HsStrictnessInfo [Demand]
 429                      (Maybe (name, [name]))     -- Worker, if any
 430                                                 -- and needed constructors
 431   | HsBottom
 432 \end{code}