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 module HsPragmas where
17 #include "HsVersions.h"
20 import HsTypes ( HsType )
27 All the pragma stuff has changed. Here are some placeholders!
30 data GenPragmas name = NoGenPragmas
31 data DataPragmas name = NoDataPragmas
32 data InstancePragmas name = NoInstancePragmas
33 data ClassOpPragmas name = NoClassOpPragmas
34 data ClassPragmas name = NoClassPragmas
36 noClassPragmas = NoClassPragmas
37 isNoClassPragmas NoClassPragmas = True
39 noDataPragmas = NoDataPragmas
40 isNoDataPragmas NoDataPragmas = True
42 noGenPragmas = NoGenPragmas
43 isNoGenPragmas NoGenPragmas = True
45 noInstancePragmas = NoInstancePragmas
46 isNoInstancePragmas NoInstancePragmas = True
48 noClassOpPragmas = NoClassOpPragmas
49 isNoClassOpPragmas NoClassOpPragmas = True
51 instance Outputable name => Outputable (ClassPragmas name) where
52 ppr NoClassPragmas = empty
54 instance Outputable name => Outputable (ClassOpPragmas name) where
55 ppr NoClassOpPragmas = empty
57 instance Outputable name => Outputable (InstancePragmas name) where
58 ppr NoInstancePragmas = empty
60 instance Outputable name => Outputable (GenPragmas name) where
61 ppr NoGenPragmas = empty
64 ========================= OLD CODE SCEDULED FOR DELETION SLPJ Nov 96 ==============
69 Certain pragmas expect to be pinned onto certain constructs.
71 Pragma types may be parameterised, just as with any other
74 For a @data@ declaration---indicates which specialisations exist.
78 | DataPragmas [[Maybe (HsType name)]] -- types to which specialised
80 noDataPragmas = NoDataPragmas
81 isNoDataPragmas NoDataPragmas = True
84 These are {\em general} things you can know about any value:
88 | GenPragmas (Maybe Int) -- arity (maybe)
89 (Maybe UpdateInfo) -- update info (maybe)
90 (ImpStrictness name) -- strictness, worker-wrapper
91 (ImpUnfolding name) -- unfolding (maybe)
92 [([Maybe (HsType name)], -- Specialisations: types to which spec'd;
93 Int, -- # dicts to ignore
94 GenPragmas name)] -- Gen info about the spec'd version
96 noGenPragmas = NoGenPragmas
98 isNoGenPragmas NoGenPragmas = True
99 isNoGenPragmas _ = False
101 data ImpUnfolding name
103 | ImpMagicUnfolding FAST_STRING -- magic "unfolding"
104 -- known to the compiler by "String"
105 | ImpUnfolding UnfoldingGuidance -- always, if you like, etc.
106 (UnfoldingCoreExpr name)
108 data ImpStrictness name
110 | ImpStrictness Bool -- True <=> bottoming Id
111 [Demand] -- demand info
112 (GenPragmas name) -- about the *worker*
115 For an ordinary imported function: it can have general pragmas (only).
117 For a class's super-class dictionary selectors:
119 data ClassPragmas name
121 | SuperDictPragmas [GenPragmas name] -- list mustn't be empty
123 noClassPragmas = NoClassPragmas
125 isNoClassPragmas NoClassPragmas = True
126 isNoClassPragmas _ = False
129 For a class's method selectors:
131 data ClassOpPragmas name
133 | ClassOpPragmas (GenPragmas name) -- for method selector
134 (GenPragmas name) -- for default method
137 noClassOpPragmas = NoClassOpPragmas
139 isNoClassOpPragmas NoClassOpPragmas = True
140 isNoClassOpPragmas _ = False
144 data InstancePragmas name
147 | SimpleInstancePragma -- nothing but for the dfun itself...
150 | ConstantInstancePragma
151 (GenPragmas name) -- for the "dfun" itself
152 [(name, GenPragmas name)] -- one per class op
154 | SpecialisedInstancePragma
155 (GenPragmas name) -- for its "dfun"
156 [([Maybe (HsType name)], -- specialised instance; type...
157 Int, -- #dicts to ignore
158 InstancePragmas name)] -- (no SpecialisedInstancePragma please!)
160 noInstancePragmas = NoInstancePragmas
162 isNoInstancePragmas NoInstancePragmas = True
163 isNoInstancePragmas _ = False
166 Some instances for printing (just for debugging, really)
168 instance Outputable name => Outputable (ClassPragmas name) where
169 ppr NoClassPragmas = empty
170 ppr (SuperDictPragmas sdsel_prags)
171 = ($$) (ptext SLIT("{-superdict pragmas-}"))
174 instance Outputable name => Outputable (ClassOpPragmas name) where
175 ppr NoClassOpPragmas = empty
176 ppr (ClassOpPragmas op_prags defm_prags)
177 = ($$) (hsep [ptext SLIT("{-meth-}"), ppr op_prags])
178 (hsep [ptext SLIT("{-defm-}"), ppr defm_prags])
180 instance Outputable name => Outputable (InstancePragmas name) where
181 ppr NoInstancePragmas = empty
182 ppr (SimpleInstancePragma dfun_pragmas)
183 = hsep [ptext SLIT("{-dfun-}"), ppr dfun_pragmas]
184 ppr (ConstantInstancePragma dfun_pragmas name_pragma_pairs)
185 = ($$) (hsep [ptext SLIT("{-constm-}"), ppr dfun_pragmas])
186 (vcat (map pp_pair name_pragma_pairs))
189 = hsep [ppr n, equals, ppr prags]
191 ppr (SpecialisedInstancePragma dfun_pragmas spec_pragma_info)
192 = ($$) (hsep [ptext SLIT("{-spec'd-}"), ppr dfun_pragmas])
193 (vcat (map pp_info spec_pragma_info))
195 pp_info (ty_maybes, num_dicts, prags)
196 = hcat [brackets (hsep (map pp_ty ty_maybes)),
197 parens (int num_dicts), equals, ppr prags]
198 pp_ty Nothing = ptext SLIT("_N_")
199 pp_ty (Just t)= ppr t
201 instance Outputable name => Outputable (GenPragmas name) where
202 ppr NoGenPragmas = empty
203 ppr (GenPragmas arity_maybe upd_maybe def strictness unfolding specs)
204 = hsep [pp_arity arity_maybe, pp_upd upd_maybe, -- ToDo: print def?
205 pp_str strictness, pp_unf unfolding,
208 pp_arity Nothing = empty
209 pp_arity (Just i) = (<>) (ptext SLIT("ARITY=")) (int i)
211 pp_upd Nothing = empty
212 pp_upd (Just u) = ppUpdateInfo u
214 pp_str NoImpStrictness = empty
215 pp_str (ImpStrictness is_bot demands wrkr_prags)
216 = hcat [ptext SLIT("IS_BOT="), ppr is_bot,
217 ptext SLIT("STRICTNESS="), text (showList demands ""),
218 ptext SLIT(" {"), ppr wrkr_prags, char '}']
220 pp_unf NoImpUnfolding = ptext SLIT("NO_UNFOLDING")
221 pp_unf (ImpMagicUnfolding m) = (<>) (ptext SLIT("MAGIC=")) (ptext m)
222 pp_unf (ImpUnfolding g core) = (<>) (ptext SLIT("UNFOLD=")) (ppr core)
226 = hcat [ptext SLIT("SPECS=["), hsep (map pp_spec specs), char ']']
228 pp_spec (ty_maybes, num_dicts, gprags)
229 = hsep [brackets (hsep (map pp_MaB ty_maybes)), int num_dicts, ppr gprags]
231 pp_MaB Nothing = ptext SLIT("_N_")
232 pp_MaB (Just x) = ppr x