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