2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1996
4 %************************************************************************
6 \section[HsPragmas]{Pragmas in Haskell interface files}
8 %************************************************************************
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).
15 #include "HsVersions.h"
17 module HsPragmas where
22 import HsTypes ( HsType )
26 import SpecEnv ( SpecEnv )
27 import Outputable ( Outputable(..) )
31 All the pragma stuff has changed. Here are some placeholders!
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
40 noClassPragmas = NoClassPragmas
41 isNoClassPragmas NoClassPragmas = True
43 noDataPragmas = NoDataPragmas
44 isNoDataPragmas NoDataPragmas = True
46 noGenPragmas = NoGenPragmas
47 isNoGenPragmas NoGenPragmas = True
49 noInstancePragmas = NoInstancePragmas
50 isNoInstancePragmas NoInstancePragmas = True
52 noClassOpPragmas = NoClassOpPragmas
53 isNoClassOpPragmas NoClassOpPragmas = True
55 instance Outputable name => Outputable (ClassPragmas name) where
56 ppr sty NoClassPragmas = empty
58 instance Outputable name => Outputable (ClassOpPragmas name) where
59 ppr sty NoClassOpPragmas = empty
61 instance Outputable name => Outputable (InstancePragmas name) where
62 ppr sty NoInstancePragmas = empty
64 instance Outputable name => Outputable (GenPragmas name) where
65 ppr sty NoGenPragmas = empty
68 ========================= OLD CODE SCEDULED FOR DELETION SLPJ Nov 96 ==============
73 Certain pragmas expect to be pinned onto certain constructs.
75 Pragma types may be parameterised, just as with any other
78 For a @data@ declaration---indicates which specialisations exist.
82 | DataPragmas [[Maybe (HsType name)]] -- types to which specialised
84 noDataPragmas = NoDataPragmas
85 isNoDataPragmas NoDataPragmas = True
88 These are {\em general} things you can know about any value:
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
101 noGenPragmas = NoGenPragmas
103 isNoGenPragmas NoGenPragmas = True
104 isNoGenPragmas _ = False
106 data ImpUnfolding name
108 | ImpMagicUnfolding FAST_STRING -- magic "unfolding"
109 -- known to the compiler by "String"
110 | ImpUnfolding UnfoldingGuidance -- always, if you like, etc.
111 (UnfoldingCoreExpr name)
113 data ImpStrictness name
115 | ImpStrictness Bool -- True <=> bottoming Id
116 [Demand] -- demand info
117 (GenPragmas name) -- about the *worker*
120 For an ordinary imported function: it can have general pragmas (only).
122 For a class's super-class dictionary selectors:
124 data ClassPragmas name
126 | SuperDictPragmas [GenPragmas name] -- list mustn't be empty
128 noClassPragmas = NoClassPragmas
130 isNoClassPragmas NoClassPragmas = True
131 isNoClassPragmas _ = False
134 For a class's method selectors:
136 data ClassOpPragmas name
138 | ClassOpPragmas (GenPragmas name) -- for method selector
139 (GenPragmas name) -- for default method
142 noClassOpPragmas = NoClassOpPragmas
144 isNoClassOpPragmas NoClassOpPragmas = True
145 isNoClassOpPragmas _ = False
149 data InstancePragmas name
152 | SimpleInstancePragma -- nothing but for the dfun itself...
155 | ConstantInstancePragma
156 (GenPragmas name) -- for the "dfun" itself
157 [(name, GenPragmas name)] -- one per class op
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!)
165 noInstancePragmas = NoInstancePragmas
167 isNoInstancePragmas NoInstancePragmas = True
168 isNoInstancePragmas _ = False
171 Some instances for printing (just for debugging, really)
173 instance Outputable name => Outputable (ClassPragmas name) where
174 ppr sty NoClassPragmas = empty
175 ppr sty (SuperDictPragmas sdsel_prags)
176 = ($$) (ptext SLIT("{-superdict pragmas-}"))
177 (ppr sty sdsel_prags)
179 instance Outputable name => Outputable (ClassOpPragmas name) where
180 ppr sty NoClassOpPragmas = empty
181 ppr sty (ClassOpPragmas op_prags defm_prags)
182 = ($$) (hsep [ptext SLIT("{-meth-}"), ppr sty op_prags])
183 (hsep [ptext SLIT("{-defm-}"), ppr sty defm_prags])
185 instance Outputable name => Outputable (InstancePragmas name) where
186 ppr sty NoInstancePragmas = empty
187 ppr sty (SimpleInstancePragma dfun_pragmas)
188 = hsep [ptext SLIT("{-dfun-}"), ppr sty dfun_pragmas]
189 ppr sty (ConstantInstancePragma dfun_pragmas name_pragma_pairs)
190 = ($$) (hsep [ptext SLIT("{-constm-}"), ppr sty dfun_pragmas])
191 (vcat (map pp_pair name_pragma_pairs))
194 = hsep [ppr sty n, equals, ppr sty prags]
196 ppr sty (SpecialisedInstancePragma dfun_pragmas spec_pragma_info)
197 = ($$) (hsep [ptext SLIT("{-spec'd-}"), ppr sty dfun_pragmas])
198 (vcat (map pp_info spec_pragma_info))
200 pp_info (ty_maybes, num_dicts, prags)
201 = hcat [brackets (hsep (map pp_ty ty_maybes)),
202 parens (int num_dicts), equals, ppr sty prags]
203 pp_ty Nothing = ptext SLIT("_N_")
204 pp_ty (Just t)= ppr sty t
206 instance Outputable name => Outputable (GenPragmas name) where
207 ppr sty NoGenPragmas = empty
208 ppr sty (GenPragmas arity_maybe upd_maybe def strictness unfolding specs)
209 = hsep [pp_arity arity_maybe, pp_upd upd_maybe, -- ToDo: print def?
210 pp_str strictness, pp_unf unfolding,
213 pp_arity Nothing = empty
214 pp_arity (Just i) = (<>) (ptext SLIT("ARITY=")) (int i)
216 pp_upd Nothing = empty
217 pp_upd (Just u) = ppUpdateInfo sty u
219 pp_str NoImpStrictness = empty
220 pp_str (ImpStrictness is_bot demands wrkr_prags)
221 = hcat [ptext SLIT("IS_BOT="), ppr sty is_bot,
222 ptext SLIT("STRICTNESS="), text (showList demands ""),
223 ptext SLIT(" {"), ppr sty wrkr_prags, char '}']
225 pp_unf NoImpUnfolding = ptext SLIT("NO_UNFOLDING")
226 pp_unf (ImpMagicUnfolding m) = (<>) (ptext SLIT("MAGIC=")) (ptext m)
227 pp_unf (ImpUnfolding g core) = (<>) (ptext SLIT("UNFOLD=")) (ppr sty core)
231 = hcat [ptext SLIT("SPECS=["), hsep (map pp_spec specs), char ']']
233 pp_spec (ty_maybes, num_dicts, gprags)
234 = hsep [brackets (hsep (map pp_MaB ty_maybes)), int num_dicts, ppr sty gprags]
236 pp_MaB Nothing = ptext SLIT("_N_")
237 pp_MaB (Just x) = ppr sty x