7 import U_coresyn ( U_coresyn ) -- for interfaces only
10 import U_literal ( U_literal ) -- for interfaces only
12 data U_binding = U_tbind U_list U_ttype U_list U_list U_long U_hpragma | U_nbind U_ttype U_ttype U_long U_hpragma | U_pbind U_list U_long | U_fbind U_list U_long | U_abind U_binding U_binding | U_ibind U_list U_unkId U_ttype U_binding U_long U_hpragma | U_dbind U_list U_long | U_cbind U_list U_ttype U_binding U_long U_hpragma | U_sbind U_list U_ttype U_long U_hpragma | U_mbind U_stringId U_list U_list U_long | U_nullbind | U_import U_stringId U_list U_list U_binding U_stringId U_long | U_hiding U_stringId U_list U_list U_binding U_stringId U_long | U_vspec_uprag U_unkId U_list U_long | U_vspec_ty_and_id U_ttype U_list | U_ispec_uprag U_unkId U_ttype U_long | U_inline_uprag U_unkId U_list U_long | U_deforest_uprag U_unkId U_long | U_magicuf_uprag U_unkId U_stringId U_long | U_abstract_uprag U_unkId U_long | U_dspec_uprag U_unkId U_list U_long
14 rdU_binding :: _Addr -> UgnM U_binding
16 = ioToUgnM (_ccall_ tbinding t) `thenUgn` \ tag@(I# _) ->
17 if tag == ``tbind'' then
18 ioToUgnM (_ccall_ gtbindc t) `thenUgn` \ x_gtbindc ->
19 rdU_list x_gtbindc `thenUgn` \ y_gtbindc ->
20 ioToUgnM (_ccall_ gtbindid t) `thenUgn` \ x_gtbindid ->
21 rdU_ttype x_gtbindid `thenUgn` \ y_gtbindid ->
22 ioToUgnM (_ccall_ gtbindl t) `thenUgn` \ x_gtbindl ->
23 rdU_list x_gtbindl `thenUgn` \ y_gtbindl ->
24 ioToUgnM (_ccall_ gtbindd t) `thenUgn` \ x_gtbindd ->
25 rdU_list x_gtbindd `thenUgn` \ y_gtbindd ->
26 ioToUgnM (_ccall_ gtline t) `thenUgn` \ x_gtline ->
27 rdU_long x_gtline `thenUgn` \ y_gtline ->
28 ioToUgnM (_ccall_ gtpragma t) `thenUgn` \ x_gtpragma ->
29 rdU_hpragma x_gtpragma `thenUgn` \ y_gtpragma ->
30 returnUgn (U_tbind y_gtbindc y_gtbindid y_gtbindl y_gtbindd y_gtline y_gtpragma)
31 else if tag == ``nbind'' then
32 ioToUgnM (_ccall_ gnbindid t) `thenUgn` \ x_gnbindid ->
33 rdU_ttype x_gnbindid `thenUgn` \ y_gnbindid ->
34 ioToUgnM (_ccall_ gnbindas t) `thenUgn` \ x_gnbindas ->
35 rdU_ttype x_gnbindas `thenUgn` \ y_gnbindas ->
36 ioToUgnM (_ccall_ gnline t) `thenUgn` \ x_gnline ->
37 rdU_long x_gnline `thenUgn` \ y_gnline ->
38 ioToUgnM (_ccall_ gnpragma t) `thenUgn` \ x_gnpragma ->
39 rdU_hpragma x_gnpragma `thenUgn` \ y_gnpragma ->
40 returnUgn (U_nbind y_gnbindid y_gnbindas y_gnline y_gnpragma)
41 else if tag == ``pbind'' then
42 ioToUgnM (_ccall_ gpbindl t) `thenUgn` \ x_gpbindl ->
43 rdU_list x_gpbindl `thenUgn` \ y_gpbindl ->
44 ioToUgnM (_ccall_ gpline t) `thenUgn` \ x_gpline ->
45 rdU_long x_gpline `thenUgn` \ y_gpline ->
46 returnUgn (U_pbind y_gpbindl y_gpline)
47 else if tag == ``fbind'' then
48 ioToUgnM (_ccall_ gfbindl t) `thenUgn` \ x_gfbindl ->
49 rdU_list x_gfbindl `thenUgn` \ y_gfbindl ->
50 ioToUgnM (_ccall_ gfline t) `thenUgn` \ x_gfline ->
51 rdU_long x_gfline `thenUgn` \ y_gfline ->
52 returnUgn (U_fbind y_gfbindl y_gfline)
53 else if tag == ``abind'' then
54 ioToUgnM (_ccall_ gabindfst t) `thenUgn` \ x_gabindfst ->
55 rdU_binding x_gabindfst `thenUgn` \ y_gabindfst ->
56 ioToUgnM (_ccall_ gabindsnd t) `thenUgn` \ x_gabindsnd ->
57 rdU_binding x_gabindsnd `thenUgn` \ y_gabindsnd ->
58 returnUgn (U_abind y_gabindfst y_gabindsnd)
59 else if tag == ``ibind'' then
60 ioToUgnM (_ccall_ gibindc t) `thenUgn` \ x_gibindc ->
61 rdU_list x_gibindc `thenUgn` \ y_gibindc ->
62 ioToUgnM (_ccall_ gibindid t) `thenUgn` \ x_gibindid ->
63 rdU_unkId x_gibindid `thenUgn` \ y_gibindid ->
64 ioToUgnM (_ccall_ gibindi t) `thenUgn` \ x_gibindi ->
65 rdU_ttype x_gibindi `thenUgn` \ y_gibindi ->
66 ioToUgnM (_ccall_ gibindw t) `thenUgn` \ x_gibindw ->
67 rdU_binding x_gibindw `thenUgn` \ y_gibindw ->
68 ioToUgnM (_ccall_ giline t) `thenUgn` \ x_giline ->
69 rdU_long x_giline `thenUgn` \ y_giline ->
70 ioToUgnM (_ccall_ gipragma t) `thenUgn` \ x_gipragma ->
71 rdU_hpragma x_gipragma `thenUgn` \ y_gipragma ->
72 returnUgn (U_ibind y_gibindc y_gibindid y_gibindi y_gibindw y_giline y_gipragma)
73 else if tag == ``dbind'' then
74 ioToUgnM (_ccall_ gdbindts t) `thenUgn` \ x_gdbindts ->
75 rdU_list x_gdbindts `thenUgn` \ y_gdbindts ->
76 ioToUgnM (_ccall_ gdline t) `thenUgn` \ x_gdline ->
77 rdU_long x_gdline `thenUgn` \ y_gdline ->
78 returnUgn (U_dbind y_gdbindts y_gdline)
79 else if tag == ``cbind'' then
80 ioToUgnM (_ccall_ gcbindc t) `thenUgn` \ x_gcbindc ->
81 rdU_list x_gcbindc `thenUgn` \ y_gcbindc ->
82 ioToUgnM (_ccall_ gcbindid t) `thenUgn` \ x_gcbindid ->
83 rdU_ttype x_gcbindid `thenUgn` \ y_gcbindid ->
84 ioToUgnM (_ccall_ gcbindw t) `thenUgn` \ x_gcbindw ->
85 rdU_binding x_gcbindw `thenUgn` \ y_gcbindw ->
86 ioToUgnM (_ccall_ gcline t) `thenUgn` \ x_gcline ->
87 rdU_long x_gcline `thenUgn` \ y_gcline ->
88 ioToUgnM (_ccall_ gcpragma t) `thenUgn` \ x_gcpragma ->
89 rdU_hpragma x_gcpragma `thenUgn` \ y_gcpragma ->
90 returnUgn (U_cbind y_gcbindc y_gcbindid y_gcbindw y_gcline y_gcpragma)
91 else if tag == ``sbind'' then
92 ioToUgnM (_ccall_ gsbindids t) `thenUgn` \ x_gsbindids ->
93 rdU_list x_gsbindids `thenUgn` \ y_gsbindids ->
94 ioToUgnM (_ccall_ gsbindid t) `thenUgn` \ x_gsbindid ->
95 rdU_ttype x_gsbindid `thenUgn` \ y_gsbindid ->
96 ioToUgnM (_ccall_ gsline t) `thenUgn` \ x_gsline ->
97 rdU_long x_gsline `thenUgn` \ y_gsline ->
98 ioToUgnM (_ccall_ gspragma t) `thenUgn` \ x_gspragma ->
99 rdU_hpragma x_gspragma `thenUgn` \ y_gspragma ->
100 returnUgn (U_sbind y_gsbindids y_gsbindid y_gsline y_gspragma)
101 else if tag == ``mbind'' then
102 ioToUgnM (_ccall_ gmbindmodn t) `thenUgn` \ x_gmbindmodn ->
103 rdU_stringId x_gmbindmodn `thenUgn` \ y_gmbindmodn ->
104 ioToUgnM (_ccall_ gmbindimp t) `thenUgn` \ x_gmbindimp ->
105 rdU_list x_gmbindimp `thenUgn` \ y_gmbindimp ->
106 ioToUgnM (_ccall_ gmbindren t) `thenUgn` \ x_gmbindren ->
107 rdU_list x_gmbindren `thenUgn` \ y_gmbindren ->
108 ioToUgnM (_ccall_ gmline t) `thenUgn` \ x_gmline ->
109 rdU_long x_gmline `thenUgn` \ y_gmline ->
110 returnUgn (U_mbind y_gmbindmodn y_gmbindimp y_gmbindren y_gmline)
111 else if tag == ``nullbind'' then
112 returnUgn (U_nullbind )
113 else if tag == ``import'' then
114 ioToUgnM (_ccall_ giebindmod t) `thenUgn` \ x_giebindmod ->
115 rdU_stringId x_giebindmod `thenUgn` \ y_giebindmod ->
116 ioToUgnM (_ccall_ giebindexp t) `thenUgn` \ x_giebindexp ->
117 rdU_list x_giebindexp `thenUgn` \ y_giebindexp ->
118 ioToUgnM (_ccall_ giebindren t) `thenUgn` \ x_giebindren ->
119 rdU_list x_giebindren `thenUgn` \ y_giebindren ->
120 ioToUgnM (_ccall_ giebinddef t) `thenUgn` \ x_giebinddef ->
121 rdU_binding x_giebinddef `thenUgn` \ y_giebinddef ->
122 ioToUgnM (_ccall_ giebindfile t) `thenUgn` \ x_giebindfile ->
123 rdU_stringId x_giebindfile `thenUgn` \ y_giebindfile ->
124 ioToUgnM (_ccall_ giebindline t) `thenUgn` \ x_giebindline ->
125 rdU_long x_giebindline `thenUgn` \ y_giebindline ->
126 returnUgn (U_import y_giebindmod y_giebindexp y_giebindren y_giebinddef y_giebindfile y_giebindline)
127 else if tag == ``hiding'' then
128 ioToUgnM (_ccall_ gihbindmod t) `thenUgn` \ x_gihbindmod ->
129 rdU_stringId x_gihbindmod `thenUgn` \ y_gihbindmod ->
130 ioToUgnM (_ccall_ gihbindexp t) `thenUgn` \ x_gihbindexp ->
131 rdU_list x_gihbindexp `thenUgn` \ y_gihbindexp ->
132 ioToUgnM (_ccall_ gihbindren t) `thenUgn` \ x_gihbindren ->
133 rdU_list x_gihbindren `thenUgn` \ y_gihbindren ->
134 ioToUgnM (_ccall_ gihbinddef t) `thenUgn` \ x_gihbinddef ->
135 rdU_binding x_gihbinddef `thenUgn` \ y_gihbinddef ->
136 ioToUgnM (_ccall_ gihbindfile t) `thenUgn` \ x_gihbindfile ->
137 rdU_stringId x_gihbindfile `thenUgn` \ y_gihbindfile ->
138 ioToUgnM (_ccall_ gihbindline t) `thenUgn` \ x_gihbindline ->
139 rdU_long x_gihbindline `thenUgn` \ y_gihbindline ->
140 returnUgn (U_hiding y_gihbindmod y_gihbindexp y_gihbindren y_gihbinddef y_gihbindfile y_gihbindline)
141 else if tag == ``vspec_uprag'' then
142 ioToUgnM (_ccall_ gvspec_id t) `thenUgn` \ x_gvspec_id ->
143 rdU_unkId x_gvspec_id `thenUgn` \ y_gvspec_id ->
144 ioToUgnM (_ccall_ gvspec_tys t) `thenUgn` \ x_gvspec_tys ->
145 rdU_list x_gvspec_tys `thenUgn` \ y_gvspec_tys ->
146 ioToUgnM (_ccall_ gvspec_line t) `thenUgn` \ x_gvspec_line ->
147 rdU_long x_gvspec_line `thenUgn` \ y_gvspec_line ->
148 returnUgn (U_vspec_uprag y_gvspec_id y_gvspec_tys y_gvspec_line)
149 else if tag == ``vspec_ty_and_id'' then
150 ioToUgnM (_ccall_ gvspec_ty t) `thenUgn` \ x_gvspec_ty ->
151 rdU_ttype x_gvspec_ty `thenUgn` \ y_gvspec_ty ->
152 ioToUgnM (_ccall_ gvspec_tyid t) `thenUgn` \ x_gvspec_tyid ->
153 rdU_list x_gvspec_tyid `thenUgn` \ y_gvspec_tyid ->
154 returnUgn (U_vspec_ty_and_id y_gvspec_ty y_gvspec_tyid)
155 else if tag == ``ispec_uprag'' then
156 ioToUgnM (_ccall_ gispec_clas t) `thenUgn` \ x_gispec_clas ->
157 rdU_unkId x_gispec_clas `thenUgn` \ y_gispec_clas ->
158 ioToUgnM (_ccall_ gispec_ty t) `thenUgn` \ x_gispec_ty ->
159 rdU_ttype x_gispec_ty `thenUgn` \ y_gispec_ty ->
160 ioToUgnM (_ccall_ gispec_line t) `thenUgn` \ x_gispec_line ->
161 rdU_long x_gispec_line `thenUgn` \ y_gispec_line ->
162 returnUgn (U_ispec_uprag y_gispec_clas y_gispec_ty y_gispec_line)
163 else if tag == ``inline_uprag'' then
164 ioToUgnM (_ccall_ ginline_id t) `thenUgn` \ x_ginline_id ->
165 rdU_unkId x_ginline_id `thenUgn` \ y_ginline_id ->
166 ioToUgnM (_ccall_ ginline_howto t) `thenUgn` \ x_ginline_howto ->
167 rdU_list x_ginline_howto `thenUgn` \ y_ginline_howto ->
168 ioToUgnM (_ccall_ ginline_line t) `thenUgn` \ x_ginline_line ->
169 rdU_long x_ginline_line `thenUgn` \ y_ginline_line ->
170 returnUgn (U_inline_uprag y_ginline_id y_ginline_howto y_ginline_line)
171 else if tag == ``deforest_uprag'' then
172 ioToUgnM (_ccall_ gdeforest_id t) `thenUgn` \ x_gdeforest_id ->
173 rdU_unkId x_gdeforest_id `thenUgn` \ y_gdeforest_id ->
174 ioToUgnM (_ccall_ gdeforest_line t) `thenUgn` \ x_gdeforest_line ->
175 rdU_long x_gdeforest_line `thenUgn` \ y_gdeforest_line ->
176 returnUgn (U_deforest_uprag y_gdeforest_id y_gdeforest_line)
177 else if tag == ``magicuf_uprag'' then
178 ioToUgnM (_ccall_ gmagicuf_id t) `thenUgn` \ x_gmagicuf_id ->
179 rdU_unkId x_gmagicuf_id `thenUgn` \ y_gmagicuf_id ->
180 ioToUgnM (_ccall_ gmagicuf_str t) `thenUgn` \ x_gmagicuf_str ->
181 rdU_stringId x_gmagicuf_str `thenUgn` \ y_gmagicuf_str ->
182 ioToUgnM (_ccall_ gmagicuf_line t) `thenUgn` \ x_gmagicuf_line ->
183 rdU_long x_gmagicuf_line `thenUgn` \ y_gmagicuf_line ->
184 returnUgn (U_magicuf_uprag y_gmagicuf_id y_gmagicuf_str y_gmagicuf_line)
185 else if tag == ``abstract_uprag'' then
186 ioToUgnM (_ccall_ gabstract_id t) `thenUgn` \ x_gabstract_id ->
187 rdU_unkId x_gabstract_id `thenUgn` \ y_gabstract_id ->
188 ioToUgnM (_ccall_ gabstract_line t) `thenUgn` \ x_gabstract_line ->
189 rdU_long x_gabstract_line `thenUgn` \ y_gabstract_line ->
190 returnUgn (U_abstract_uprag y_gabstract_id y_gabstract_line)
191 else if tag == ``dspec_uprag'' then
192 ioToUgnM (_ccall_ gdspec_id t) `thenUgn` \ x_gdspec_id ->
193 rdU_unkId x_gdspec_id `thenUgn` \ y_gdspec_id ->
194 ioToUgnM (_ccall_ gdspec_tys t) `thenUgn` \ x_gdspec_tys ->
195 rdU_list x_gdspec_tys `thenUgn` \ y_gdspec_tys ->
196 ioToUgnM (_ccall_ gdspec_line t) `thenUgn` \ x_gdspec_line ->
197 rdU_long x_gdspec_line `thenUgn` \ y_gdspec_line ->
198 returnUgn (U_dspec_uprag y_gdspec_id y_gdspec_tys y_gdspec_line)
200 error ("rdU_binding: bad tag selection:"++show tag++"\n")