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).
  13
  14 \begin{code}
  15 #include "HsVersions.h"
  16
  17 module HsPragmas where
  18
  19 IMP_Ubiq()
  20
  21 -- friends:
  22 import HsTypes          ( HsType )
  23
  24 -- others:
  25 import IdInfo
  26 import SpecEnv          ( SpecEnv )
  27 import Outputable       ( Outputable(..) )
  28 import Pretty
  29 \end{code}
  30
  31 All the pragma stuff has changed.  Here are some placeholders!
  32
  33 \begin{code}
  34 data GenPragmas name  = NoGenPragmas
  35 data DataPragmas name = NoDataPragmas
  36 data InstancePragmas name = NoInstancePragmas
  37 data ClassOpPragmas name  = NoClassOpPragmas
  38 data ClassPragmas name  = NoClassPragmas
  39
  40 noClassPragmas = NoClassPragmas
  41 isNoClassPragmas NoClassPragmas = True
  42
  43 noDataPragmas = NoDataPragmas
  44 isNoDataPragmas NoDataPragmas = True
  45
  46 noGenPragmas = NoGenPragmas
  47 isNoGenPragmas NoGenPragmas = True
  48
  49 noInstancePragmas = NoInstancePragmas
  50 isNoInstancePragmas NoInstancePragmas = True
  51
  52 noClassOpPragmas = NoClassOpPragmas
  53 isNoClassOpPragmas NoClassOpPragmas = True
  54
  55 instance Outputable name => Outputable (ClassPragmas name) where
  56     ppr sty NoClassPragmas = ppNil
  57
  58 instance Outputable name => Outputable (ClassOpPragmas name) where
  59     ppr sty NoClassOpPragmas = ppNil
  60
  61 instance Outputable name => Outputable (InstancePragmas name) where
  62     ppr sty NoInstancePragmas = ppNil
  63
  64 instance Outputable name => Outputable (GenPragmas name) where
  65     ppr sty NoGenPragmas = ppNil
  66 \end{code}
  67
  68 ========================= OLD CODE SCEDULED FOR DELETION SLPJ Nov 96 ==============
  69
  70 \begin{code}
  71 {-              COMMENTED OUT
  72
  73 Certain pragmas expect to be pinned onto certain constructs.
  74
  75 Pragma types may be parameterised, just as with any other
  76 abstract-syntax type.
  77
  78 For a @data@ declaration---indicates which specialisations exist.
  79 \begin{code}
  80 data DataPragmas name
  81   = NoDataPragmas
  82   | DataPragmas [[Maybe (HsType name)]]  -- types to which specialised
  83
  84 noDataPragmas = NoDataPragmas
  85 isNoDataPragmas NoDataPragmas = True
  86 \end{code}
  87
  88 These are {\em general} things you can know about any value:
  89 \begin{code}
  90 data GenPragmas name
  91   = NoGenPragmas
  92   | GenPragmas  (Maybe Int)             -- arity (maybe)
  93                 (Maybe UpdateInfo)      -- update info (maybe)
  94                 DeforestInfo            -- deforest info
  95                 (ImpStrictness name)    -- strictness, worker-wrapper
  96                 (ImpUnfolding name)     -- unfolding (maybe)
  97                 [([Maybe (HsType name)], -- Specialisations: types to which spec'd;
  98                   Int,                     -- # dicts to ignore
  99                   GenPragmas name)]        -- Gen info about the spec'd version
 100
 101 noGenPragmas = NoGenPragmas
 102
 103 isNoGenPragmas NoGenPragmas = True
 104 isNoGenPragmas _            = False
 105
 106 data ImpUnfolding name
 107   = NoImpUnfolding
 108   | ImpMagicUnfolding FAST_STRING       -- magic "unfolding"
 109                                         -- known to the compiler by "String"
 110   | ImpUnfolding UnfoldingGuidance      -- always, if you like, etc.
 111                  (UnfoldingCoreExpr name)
 112
 113 data ImpStrictness name
 114   = NoImpStrictness
 115   | ImpStrictness Bool                  -- True <=> bottoming Id
 116                   [Demand]              -- demand info
 117                   (GenPragmas name)     -- about the *worker*
 118 \end{code}
 119
 120 For an ordinary imported function: it can have general pragmas (only).
 121
 122 For a class's super-class dictionary selectors:
 123 \begin{code}
 124 data ClassPragmas name
 125   = NoClassPragmas
 126   | SuperDictPragmas [GenPragmas name]  -- list mustn't be empty
 127
 128 noClassPragmas = NoClassPragmas
 129
 130 isNoClassPragmas NoClassPragmas = True
 131 isNoClassPragmas _              = False
 132 \end{code}
 133
 134 For a class's method selectors:
 135 \begin{code}
 136 data ClassOpPragmas name
 137   = NoClassOpPragmas
 138   | ClassOpPragmas  (GenPragmas name) -- for method selector
 139                     (GenPragmas name) -- for default method
 140
 141
 142 noClassOpPragmas = NoClassOpPragmas
 143
 144 isNoClassOpPragmas NoClassOpPragmas = True
 145 isNoClassOpPragmas _                = False
 146 \end{code}
 147
 148 \begin{code}
 149 data InstancePragmas name
 150   = NoInstancePragmas
 151
 152   | SimpleInstancePragma           -- nothing but for the dfun itself...
 153         (GenPragmas name)
 154
 155   | ConstantInstancePragma
 156         (GenPragmas name)          -- for the "dfun" itself
 157         [(name, GenPragmas name)]  -- one per class op
 158
 159   | SpecialisedInstancePragma
 160         (GenPragmas name)          -- for its "dfun"
 161         [([Maybe (HsType name)], -- specialised instance; type...
 162           Int,                     -- #dicts to ignore
 163           InstancePragmas name)]   -- (no SpecialisedInstancePragma please!)
 164
 165 noInstancePragmas = NoInstancePragmas
 166
 167 isNoInstancePragmas NoInstancePragmas = True
 168 isNoInstancePragmas _                 = False
 169 \end{code}
 170
 171 Some instances for printing (just for debugging, really)
 172 \begin{code}
 173 instance Outputable name => Outputable (ClassPragmas name) where
 174     ppr sty NoClassPragmas = ppNil
 175     ppr sty (SuperDictPragmas sdsel_prags)
 176       = ppAbove (ppStr "{-superdict pragmas-}")
 177                 (ppr sty sdsel_prags)
 178
 179 instance Outputable name => Outputable (ClassOpPragmas name) where
 180     ppr sty NoClassOpPragmas = ppNil
 181     ppr sty (ClassOpPragmas op_prags defm_prags)
 182       = ppAbove (ppCat [ppStr "{-meth-}", ppr sty op_prags])
 183                 (ppCat [ppStr "{-defm-}", ppr sty defm_prags])
 184
 185 instance Outputable name => Outputable (InstancePragmas name) where
 186     ppr sty NoInstancePragmas = ppNil
 187     ppr sty (SimpleInstancePragma dfun_pragmas)
 188       = ppCat [ppStr "{-dfun-}", ppr sty dfun_pragmas]
 189     ppr sty (ConstantInstancePragma dfun_pragmas name_pragma_pairs)
 190       = ppAbove (ppCat [ppStr "{-constm-}", ppr sty dfun_pragmas])
 191                 (ppAboves (map pp_pair name_pragma_pairs))
 192       where
 193         pp_pair (n, prags)
 194           = ppCat [ppr sty n, ppEquals, ppr sty prags]
 195
 196     ppr sty (SpecialisedInstancePragma dfun_pragmas spec_pragma_info)
 197       = ppAbove (ppCat [ppStr "{-spec'd-}", ppr sty dfun_pragmas])
 198                 (ppAboves (map pp_info spec_pragma_info))
 199       where
 200         pp_info (ty_maybes, num_dicts, prags)
 201           = ppBesides [ppLbrack, ppInterleave ppSP (map pp_ty ty_maybes), ppRbrack,
 202                        ppLparen, ppInt num_dicts, ppRparen, ppEquals, ppr sty prags]
 203         pp_ty Nothing = ppStr "_N_"
 204         pp_ty (Just t)= ppr sty t
 205
 206 instance Outputable name => Outputable (GenPragmas name) where
 207     ppr sty NoGenPragmas = ppNil
 208     ppr sty (GenPragmas arity_maybe upd_maybe def strictness unfolding specs)
 209       = ppCat [pp_arity arity_maybe, pp_upd upd_maybe, -- ToDo: print def?
 210                pp_str strictness, pp_unf unfolding,
 211                pp_specs specs]
 212       where
 213         pp_arity Nothing  = ppNil
 214         pp_arity (Just i) = ppBeside (ppStr "ARITY=") (ppInt i)
 215
 216         pp_upd Nothing  = ppNil
 217         pp_upd (Just u) = ppUpdateInfo sty u
 218
 219         pp_str NoImpStrictness = ppNil
 220         pp_str (ImpStrictness is_bot demands wrkr_prags)
 221           = ppBesides [ppStr "IS_BOT=", ppr sty is_bot,
 222                        ppStr "STRICTNESS=", ppStr (showList demands ""),
 223                        ppStr " {", ppr sty wrkr_prags, ppStr "}"]
 224
 225         pp_unf NoImpUnfolding = ppStr "NO_UNFOLDING"
 226         pp_unf (ImpMagicUnfolding m) = ppBeside (ppStr "MAGIC=") (ppPStr m)
 227         pp_unf (ImpUnfolding g core) = ppBeside (ppStr "UNFOLD=") (ppr sty core)
 228
 229         pp_specs [] = ppNil
 230         pp_specs specs
 231           = ppBesides [ppStr "SPECS=[", ppInterleave ppSP (map pp_spec specs), ppStr "]"]
 232           where
 233             pp_spec (ty_maybes, num_dicts, gprags)
 234               = ppCat [ppLbrack, ppInterleave ppSP (map pp_MaB ty_maybes), ppRbrack, ppInt num_dicts, ppr sty gprags]
 235
 236             pp_MaB Nothing  = ppStr "_N_"
 237             pp_MaB (Just x) = ppr sty x
 238 \end{code}
 239
 240
 241 \begin{code}
 242 -}
 243 \end{code}