ghc/compiler/hsSyn/HsPragmas.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
   3 %
   4 %************************************************************************
   5 %*                                                                      *
   6 \section[HsPragmas]{Pragmas in Haskell interface files}
   7 %*                                                                      *
   8 %************************************************************************
   9
  10 See also: @Sig@ (``signatures'') which is where user-supplied pragmas
  11 for values show up; ditto @SpecInstSig@ (for instances) and
  12 @SpecDataSig@ (for data types and type synonyms).
  13
  14 \begin{code}
  15 #include "HsVersions.h"
  16
  17 module HsPragmas where
  18
  19 import Ubiq{-uitous-}
  20
  21 -- friends:
  22 import HsLoop           ( ConDecl )
  23 import HsCore           ( UnfoldingCoreExpr )
  24 import HsTypes          ( MonoType )
  25
  26 -- others:
  27 import IdInfo
  28 import Outputable       ( Outputable(..){-instances-} )
  29 import Pretty
  30 \end{code}
  31
  32 Certain pragmas expect to be pinned onto certain constructs.
  33
  34 Pragma types may be parameterised, just as with any other
  35 abstract-syntax type.
  36
  37 For a @data@ declaration---makes visible the constructors for an
  38 abstract @data@ type and indicates which specialisations exist.
  39 \begin{code}
  40 data DataPragmas name
  41   = DataPragmas [ConDecl name]             -- hidden data constructors
  42                 [[Maybe (MonoType name)]]  -- types to which specialised
  43 \end{code}
  44
  45 These are {\em general} things you can know about any value:
  46 \begin{code}
  47 data GenPragmas name
  48   = NoGenPragmas
  49   | GenPragmas  (Maybe Int)             -- arity (maybe)
  50                 (Maybe UpdateInfo)      -- update info (maybe)
  51                 DeforestInfo            -- deforest info
  52                 (ImpStrictness name)    -- strictness, worker-wrapper
  53                 (ImpUnfolding name)     -- unfolding (maybe)
  54                 [([Maybe (MonoType name)], -- Specialisations: types to which spec'd;
  55                   Int,                     -- # dicts to ignore
  56                   GenPragmas name)]        -- Gen info about the spec'd version
  57
  58 noGenPragmas = NoGenPragmas
  59
  60 data ImpUnfolding name
  61   = NoImpUnfolding
  62   | ImpMagicUnfolding FAST_STRING       -- magic "unfolding"
  63                                         -- known to the compiler by "String"
  64   | ImpUnfolding UnfoldingGuidance      -- always, if you like, etc.
  65                  (UnfoldingCoreExpr name)
  66
  67 data ImpStrictness name
  68   = NoImpStrictness
  69   | ImpStrictness Bool                  -- True <=> bottoming Id
  70                   [Demand]              -- demand info
  71                   (GenPragmas name)     -- about the *worker*
  72 \end{code}
  73
  74 For an ordinary imported function: it can have general pragmas (only).
  75
  76 For a class's super-class dictionary selectors:
  77 \begin{code}
  78 data ClassPragmas name
  79   = NoClassPragmas
  80   | SuperDictPragmas [GenPragmas name]  -- list mustn't be empty
  81 \end{code}
  82
  83 For a class's method selectors:
  84 \begin{code}
  85 data ClassOpPragmas name
  86   = NoClassOpPragmas
  87   | ClassOpPragmas  (GenPragmas name) -- for method selector
  88                     (GenPragmas name) -- for default method
  89
  90 noClassOpPragmas = NoClassOpPragmas
  91 \end{code}
  92
  93 \begin{code}
  94 data InstancePragmas name
  95   = NoInstancePragmas
  96
  97   | SimpleInstancePragma           -- nothing but for the dfun itself...
  98         (GenPragmas name)
  99
 100   | ConstantInstancePragma
 101         (GenPragmas name)          -- for the "dfun" itself
 102         [(name, GenPragmas name)]  -- one per class op
 103
 104   | SpecialisedInstancePragma
 105         (GenPragmas name)          -- for its "dfun"
 106         [([Maybe (MonoType name)], -- specialised instance; type...
 107           Int,                     -- #dicts to ignore
 108           InstancePragmas name)]   -- (no SpecialisedInstancePragma please!)
 109 \end{code}
 110
 111 Some instances for printing (just for debugging, really)
 112 \begin{code}
 113 instance Outputable name => Outputable (ClassPragmas name) where
 114     ppr sty NoClassPragmas = ppNil
 115     ppr sty (SuperDictPragmas sdsel_prags)
 116       = ppAbove (ppStr "{-superdict pragmas-}")
 117                 (ppr sty sdsel_prags)
 118
 119 instance Outputable name => Outputable (ClassOpPragmas name) where
 120     ppr sty NoClassOpPragmas = ppNil
 121     ppr sty (ClassOpPragmas op_prags defm_prags)
 122       = ppAbove (ppCat [ppStr "{-meth-}", ppr sty op_prags])
 123                 (ppCat [ppStr "{-defm-}", ppr sty defm_prags])
 124
 125 instance Outputable name => Outputable (InstancePragmas name) where
 126     ppr sty NoInstancePragmas = ppNil
 127     ppr sty (SimpleInstancePragma dfun_pragmas)
 128       = ppCat [ppStr "{-dfun-}", ppr sty dfun_pragmas]
 129     ppr sty (ConstantInstancePragma dfun_pragmas name_pragma_pairs)
 130       = ppAbove (ppCat [ppStr "{-constm-}", ppr sty dfun_pragmas])
 131                 (ppAboves (map pp_pair name_pragma_pairs))
 132       where
 133         pp_pair (n, prags)
 134           = ppCat [ppr sty n, ppEquals, ppr sty prags]
 135
 136     ppr sty (SpecialisedInstancePragma dfun_pragmas spec_pragma_info)
 137       = ppAbove (ppCat [ppStr "{-spec'd-}", ppr sty dfun_pragmas])
 138                 (ppAboves (map pp_info spec_pragma_info))
 139       where
 140         pp_info (ty_maybes, num_dicts, prags)
 141           = ppBesides [ppLbrack, ppInterleave ppSP (map pp_ty ty_maybes), ppRbrack,
 142                        ppLparen, ppInt num_dicts, ppRparen, ppEquals, ppr sty prags]
 143         pp_ty Nothing = ppStr "_N_"
 144         pp_ty (Just t)= ppr sty t
 145
 146 instance Outputable name => Outputable (GenPragmas name) where
 147     ppr sty NoGenPragmas = ppNil
 148     ppr sty (GenPragmas arity_maybe upd_maybe def strictness unfolding specs)
 149       = ppCat [pp_arity arity_maybe, pp_upd upd_maybe, -- ToDo: print def?
 150                pp_str strictness, pp_unf unfolding,
 151                pp_specs specs]
 152       where
 153         pp_arity Nothing  = ppNil
 154         pp_arity (Just i) = ppBeside (ppStr "ARITY=") (ppInt i)
 155
 156         pp_upd Nothing  = ppNil
 157         pp_upd (Just u) = ppInfo sty id u
 158
 159         pp_str NoImpStrictness = ppNil
 160         pp_str (ImpStrictness is_bot demands wrkr_prags)
 161           = ppBesides [ppStr "IS_BOT=", ppr sty is_bot,
 162                        ppStr "STRICTNESS=", ppStr (showList demands ""),
 163                        ppStr " {", ppr sty wrkr_prags, ppStr "}"]
 164
 165         pp_unf NoImpUnfolding = ppStr "NO_UNFOLDING"
 166         pp_unf (ImpMagicUnfolding m) = ppBeside (ppStr "MAGIC=") (ppPStr m)
 167         pp_unf (ImpUnfolding g core) = ppBeside (ppStr "UNFOLD=") (ppr sty core)
 168
 169         pp_specs [] = ppNil
 170         pp_specs specs
 171           = ppBesides [ppStr "SPECS=[", ppInterleave ppSP (map pp_spec specs), ppStr "]"]
 172           where
 173             pp_spec (ty_maybes, num_dicts, gprags)
 174               = ppCat [ppLbrack, ppInterleave ppSP (map pp_MaB ty_maybes), ppRbrack, ppInt num_dicts, ppr sty gprags]
 175
 176             pp_MaB Nothing  = ppStr "_N_"
 177             pp_MaB (Just x) = ppr sty x
 178 \end{code}