@@ -105,12 +105,6 @@ let label c x =
105
105
try VarMap. find x.it c.labels
106
106
with Not_found -> error x.at (" unknown label " ^ x.it)
107
107
108
- let bind_type c x ty =
109
- if VarMap. mem x.it c.types.tmap then
110
- error x.at (" duplicate type " ^ x.it);
111
- c.types.tmap < - VarMap. add x.it (List. length c.types.tlist) c.types.tmap;
112
- c.types.tlist < - c.types.tlist @ [ty]
113
-
114
108
let bind category space x =
115
109
if VarMap. mem x.it space.map then
116
110
error x.at (" duplicate " ^ category ^ " " ^ x.it);
@@ -124,9 +118,6 @@ let bind_case c x = bind "case" c.cases x
124
118
let bind_label c x =
125
119
{c with labels = VarMap. add x.it 0 (VarMap. map ((+ ) 1 ) c.labels)}
126
120
127
- let anon_type c ty =
128
- c.types.tlist < - c.types.tlist @ [ty]
129
-
130
121
let anon space n = space.count < - space.count + n
131
122
132
123
let anon_func c = anon c.funcs 1
@@ -137,19 +128,9 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels}
137
128
138
129
let empty_type = {ins = [] ; out = None }
139
130
140
- let explicit_decl c name t at =
141
- let x = name c type_ in
142
- if
143
- x.it < List. length c.types.tlist &&
144
- t <> empty_type &&
145
- t <> List. nth c.types.tlist x.it
146
- then
147
- error at " signature mismatch" ;
148
- x
149
-
150
- let implicit_decl c t at =
131
+ let lookup_type c t at =
151
132
match Lib.List. index_of t c.types.tlist with
152
- | None -> let i = List. length c.types.tlist in anon_type c t ; i @@ at
133
+ | None -> let i = List. length c.types.tlist in c.types.tlist < - c.types.tlist @ [t] ; i @@ at
153
134
| Some i -> i @@ at
154
135
155
136
% }
@@ -159,7 +140,7 @@ let implicit_decl c t at =
159
140
% token CALL CALL_IMPORT CALL_INDIRECT RETURN
160
141
% token GET_LOCAL SET_LOCAL LOAD STORE LOAD_EXTEND STORE_WRAP OFFSET ALIGN
161
142
% token CONST UNARY BINARY COMPARE CONVERT
162
- % token FUNC TYPE PARAM RESULT LOCAL
143
+ % token FUNC FUNC_TYPE PARAM RESULT LOCAL
163
144
% token MODULE MEMORY SEGMENT IMPORT EXPORT TABLE
164
145
% token UNREACHABLE MEMORY_SIZE GROW_MEMORY HAS_FEATURE
165
146
% token ASSERT_INVALID ASSERT_RETURN ASSERT_RETURN_NAN ASSERT_TRAP INVOKE
@@ -197,7 +178,7 @@ value_type_list :
197
178
| /* empty */ { [] }
198
179
| VALUE_TYPE value_type_list { $ 1 :: $ 2 }
199
180
;
200
- func_type :
181
+ signature :
201
182
| /* empty */
202
183
{ {ins = [] ; out = None } }
203
184
| LPAR PARAM value_type_list RPAR
@@ -207,7 +188,9 @@ func_type :
207
188
| LPAR RESULT VALUE_TYPE RPAR
208
189
{ {ins = [] ; out = Some $ 3 } }
209
190
;
210
-
191
+ func_type :
192
+ | LPAR FUNC_TYPE signature RPAR { $ 3 }
193
+ ;
211
194
212
195
/* Expressions */
213
196
@@ -270,8 +253,9 @@ expr1 :
270
253
tableswitch (l, e, $ 6 c'', $ 8 c'', es) }
271
254
| CALL var expr_list { fun c -> call ($2 c func, $3 c) }
272
255
| CALL_IMPORT var expr_list { fun c -> call_import ($2 c import, $3 c) }
273
- | CALL_INDIRECT var expr expr_list
274
- { fun c -> call_indirect ($ 2 c type_, $ 3 c, $ 4 c) }
256
+ | CALL_INDIRECT func_type expr expr_list
257
+ { let at = at () in
258
+ fun c -> call_indirect (lookup_type c $ 2 at, $ 3 c, $ 4 c) }
275
259
| GET_LOCAL var { fun c -> get_local ($2 c local) }
276
260
| SET_LOCAL var expr { fun c -> set_local ($2 c local, $3 c) }
277
261
| LOAD offset align expr
@@ -347,25 +331,14 @@ func_fields :
347
331
fun c -> bind_local c $ 3 ; let f = (snd $ 6 ) c in
348
332
{f with locals = $ 4 :: f.locals} }
349
333
;
350
- type_use :
351
- | LPAR TYPE var RPAR { $ 3 }
352
- ;
353
334
func :
354
- | LPAR FUNC type_use func_fields RPAR
355
- { let at = at () in
356
- fun c -> anon_func c; let t = explicit_decl c $ 3 (fst $ 4 ) at in
357
- fun () -> {((snd $ 4 ) (enter_func c)) with ftype = t} @@ at }
358
- | LPAR FUNC bind_var type_use func_fields RPAR /* Sugar */
359
- { let at = at () in
360
- fun c -> bind_func c $ 3 ; let t = explicit_decl c $ 4 (fst $ 5 ) at in
361
- fun () -> {((snd $ 5 ) (enter_func c)) with ftype = t} @@ at }
362
335
| LPAR FUNC func_fields RPAR /* Sugar */
363
336
{ let at = at () in
364
- fun c -> anon_func c; let t = implicit_decl c (fst $ 3 ) at in
337
+ fun c -> anon_func c; let t = lookup_type c (fst $ 3 ) at in
365
338
fun () -> {((snd $ 3 ) (enter_func c)) with ftype = t} @@ at }
366
339
| LPAR FUNC bind_var func_fields RPAR /* Sugar */
367
340
{ let at = at () in
368
- fun c -> bind_func c $ 3 ; let t = implicit_decl c (fst $ 4 ) at in
341
+ fun c -> bind_func c $ 3 ; let t = lookup_type c (fst $ 4 ) at in
369
342
fun () -> {((snd $ 4 ) (enter_func c)) with ftype = t} @@ at }
370
343
;
371
344
@@ -390,34 +363,19 @@ memory :
390
363
@@ at () }
391
364
;
392
365
393
- type_def :
394
- | LPAR TYPE LPAR FUNC func_type RPAR RPAR
395
- { fun c -> anon_type c $ 5 }
396
- | LPAR TYPE bind_var LPAR FUNC func_type RPAR RPAR
397
- { fun c -> bind_type c $ 3 $ 6 }
398
- ;
399
-
400
366
table :
401
367
| LPAR TABLE var_list RPAR
402
368
{ fun c -> $ 3 c func }
403
369
;
404
370
405
371
import :
406
- | LPAR IMPORT TEXT TEXT type_use RPAR
407
- { let at = at () in
408
- fun c -> anon_import c; let itype = explicit_decl c $ 5 empty_type at in
409
- {itype; module_name = $ 3 ; func_name = $ 4 } @@ at }
410
- | LPAR IMPORT bind_var TEXT TEXT type_use RPAR /* Sugar */
411
- { let at = at () in
412
- fun c -> bind_import c $ 3 ; let itype = explicit_decl c $ 6 empty_type at in
413
- {itype; module_name = $ 4 ; func_name = $ 5 } @@ at }
414
372
| LPAR IMPORT TEXT TEXT func_type RPAR /* Sugar */
415
373
{ let at = at () in
416
- fun c -> anon_import c; let itype = implicit_decl c $ 5 at in
374
+ fun c -> anon_import c; let itype = lookup_type c $ 5 at in
417
375
{itype; module_name = $ 3 ; func_name = $ 4 } @@ at }
418
376
| LPAR IMPORT bind_var TEXT TEXT func_type RPAR /* Sugar */
419
377
{ let at = at () in
420
- fun c -> bind_import c $ 3 ; let itype = implicit_decl c $ 6 at in
378
+ fun c -> bind_import c $ 3 ; let itype = lookup_type c $ 6 at in
421
379
{itype; module_name = $ 4 ; func_name = $ 5 } @@ at }
422
380
;
423
381
@@ -443,8 +401,6 @@ module_fields :
443
401
| table module_fields
444
402
{ fun c -> let m = $ 2 c in
445
403
{m with table = ($ 1 c) @ m.table} }
446
- | type_def module_fields
447
- { fun c -> $ 1 c; $ 2 c }
448
404
| memory module_fields
449
405
{ fun c -> let m = $ 2 c in
450
406
match m.memory with
0 commit comments