add iter test
This commit is contained in:
zapashcanon
parent
57f090da8e
commit
62d350f03d
GPG Key ID:
8981C3C62D1D28F1
@ -64,6 +64,7 @@ let rec term envs store t =
|
||||
let v = String_map.find x env0 in
|
||||
let f_addr =
|
||||
match String_map.find f env0 with
|
||||
| exception Not_found -> Format.ksprintf failwith "%s not found !" f
|
||||
| Address n -> n
|
||||
| Scalar _ | Exn _ ->
|
||||
failwith "expected address but got scalar/raise (application)"
|
||||
|
||||
@ -10,4 +10,5 @@
|
||||
g.flambda1
|
||||
h.flambda1
|
||||
i.flambda1
|
||||
iter.flambda1
|
||||
w.flambda1))
|
||||
|
||||
46
test/cram/iter.flambda1
Normal file
46
test/cram/iter.flambda1
Normal file
@ -0,0 +1,46 @@
|
||||
let f =
|
||||
let s =
|
||||
make_closures
|
||||
| cl_f { x } env -> print_int x
|
||||
with vars
|
||||
end
|
||||
in
|
||||
project_closure cl_f from s
|
||||
in
|
||||
|
||||
let iter =
|
||||
let set =
|
||||
make_closures
|
||||
| cl_iter { f } env ->
|
||||
let otherset =
|
||||
make_closures
|
||||
| cl_iter_f { l } envtwo ->
|
||||
switch l
|
||||
with int
|
||||
| 0 -> const 0
|
||||
with tag
|
||||
| 0 ->
|
||||
let x = get_field 0 l in
|
||||
let f = project_var f from envtwo in
|
||||
let dummy = f x in
|
||||
let tl = get_field 1 l in
|
||||
envtwo tl
|
||||
end
|
||||
with vars
|
||||
| f -> f
|
||||
end
|
||||
in
|
||||
project_closure cl_iter_f from otherset
|
||||
with vars
|
||||
end
|
||||
in
|
||||
project_closure cl_iter from set
|
||||
in
|
||||
|
||||
let lempty = const 0 in
|
||||
let one = const 1 in
|
||||
let lone = make_block 0 one lempty in
|
||||
let two = const 2 in
|
||||
let ltwo = make_block 0 two lone in
|
||||
let iter_print = iter f in
|
||||
iter_print ltwo
|
||||
293
test/cram/iter.t
Normal file
293
test/cram/iter.t
Normal file
@ -0,0 +1,293 @@
|
||||
g.flambda1:
|
||||
$ dune exec -- flambda iter.flambda1
|
||||
flambda source:
|
||||
***
|
||||
let f =
|
||||
let s =
|
||||
make_closures
|
||||
| cl_f { x } env ->
|
||||
print_int x
|
||||
with vars
|
||||
end
|
||||
in
|
||||
project_closure cl_f from s
|
||||
in
|
||||
let iter =
|
||||
let set =
|
||||
make_closures
|
||||
| cl_iter { f } env ->
|
||||
let otherset =
|
||||
make_closures
|
||||
| cl_iter_f { l } envtwo ->
|
||||
switch l
|
||||
with int
|
||||
| 0 ->
|
||||
const 0
|
||||
with tag
|
||||
| 0 ->
|
||||
let x =
|
||||
get_field 0 l
|
||||
in
|
||||
let f =
|
||||
project_var f from envtwo
|
||||
in
|
||||
let dummy =
|
||||
f x
|
||||
in
|
||||
let tl =
|
||||
get_field 1 l
|
||||
in
|
||||
envtwo tl
|
||||
end
|
||||
with vars
|
||||
| f -> f
|
||||
end
|
||||
in
|
||||
project_closure cl_iter_f from otherset
|
||||
with vars
|
||||
end
|
||||
in
|
||||
project_closure cl_iter from set
|
||||
in
|
||||
let lempty =
|
||||
const 0
|
||||
in
|
||||
let one =
|
||||
const 1
|
||||
in
|
||||
let lone =
|
||||
make_block 0 one lempty
|
||||
in
|
||||
let two =
|
||||
const 2
|
||||
in
|
||||
let ltwo =
|
||||
make_block 0 two lone
|
||||
in
|
||||
let iter_print =
|
||||
iter f
|
||||
in
|
||||
iter_print ltwo
|
||||
***
|
||||
2
|
||||
1
|
||||
value const 0
|
||||
***
|
||||
(module $wasocaml_generated_modul
|
||||
|
||||
(type $mlfun (sub final (func (param eqref) (param eqref) (result eqref))))
|
||||
|
||||
(type $data (sub final (array (mut (ref null eq)))))
|
||||
|
||||
(type $block (sub final (struct
|
||||
(field i32)
|
||||
(field (ref null $data)))))
|
||||
|
||||
(type $vars (sub final (array (mut eqref))))
|
||||
(rec
|
||||
(type $set_of_closures (sub final (struct
|
||||
(field (mut (ref null $closures)))
|
||||
(field (ref null $vars)))))
|
||||
(type $closures (sub final (array (mut (ref $closure)))))
|
||||
(type $closure (sub final (struct
|
||||
(field (ref $mlfun))
|
||||
(field (mut (ref null $set_of_closures)))))))
|
||||
(import "spectest" "print_i32" (func $print_i32 (param i32) ))
|
||||
(global $tmp_set_of_closures (mut (ref null $set_of_closures)) ref.null $set_of_closures)
|
||||
(global $tmp_switch_value (mut i32) i32.const 0)
|
||||
(global $closure_offset_within_set_cl_f (mut i32) i32.const 0)
|
||||
(global $closure_offset_within_set_cl_iter (mut i32) i32.const 0)
|
||||
(global $closure_offset_within_set_cl_iter_f (mut i32) i32.const 0)
|
||||
(global $var_offset_within_set_f (mut i32) i32.const 0)
|
||||
(elem declare (ref $mlfun) (item ref.func $cl_f)
|
||||
(item ref.func $cl_iter_f)
|
||||
(item ref.func $cl_iter))
|
||||
(func $start (local $f (ref null eq)) (local $s (ref null eq)) (local $iter (ref null eq)) (local $set (ref null eq)) (local $lempty (ref null eq)) (local $one (ref null eq)) (local $lone (ref null eq)) (local $two (ref null eq)) (local $ltwo (ref null eq)) (local $iter_print (ref null eq))
|
||||
ref.null $closures
|
||||
array.new_fixed $vars 0
|
||||
struct.new $set_of_closures
|
||||
global.set $tmp_set_of_closures
|
||||
global.get $tmp_set_of_closures
|
||||
ref.func $cl_f
|
||||
global.get $tmp_set_of_closures
|
||||
struct.new $closure
|
||||
array.new_fixed $closures 1
|
||||
struct.set $set_of_closures 0
|
||||
global.get $tmp_set_of_closures
|
||||
local.set $s
|
||||
local.get $s
|
||||
ref.cast (ref $set_of_closures)
|
||||
struct.get $set_of_closures 0
|
||||
global.get $closure_offset_within_set_cl_f
|
||||
array.get $closures
|
||||
local.set $f
|
||||
ref.null $closures
|
||||
array.new_fixed $vars 0
|
||||
struct.new $set_of_closures
|
||||
global.set $tmp_set_of_closures
|
||||
global.get $tmp_set_of_closures
|
||||
ref.func $cl_iter
|
||||
global.get $tmp_set_of_closures
|
||||
struct.new $closure
|
||||
array.new_fixed $closures 1
|
||||
struct.set $set_of_closures 0
|
||||
global.get $tmp_set_of_closures
|
||||
local.set $set
|
||||
local.get $set
|
||||
ref.cast (ref $set_of_closures)
|
||||
struct.get $set_of_closures 0
|
||||
global.get $closure_offset_within_set_cl_iter
|
||||
array.get $closures
|
||||
local.set $iter
|
||||
i32.const 0
|
||||
i31.new
|
||||
local.set $lempty
|
||||
i32.const 1
|
||||
i31.new
|
||||
local.set $one
|
||||
i32.const 0
|
||||
local.get $one
|
||||
local.get $lempty
|
||||
array.new_fixed $data 2
|
||||
struct.new $block
|
||||
local.set $lone
|
||||
i32.const 2
|
||||
i31.new
|
||||
local.set $two
|
||||
i32.const 0
|
||||
local.get $two
|
||||
local.get $lone
|
||||
array.new_fixed $data 2
|
||||
struct.new $block
|
||||
local.set $ltwo
|
||||
local.get $iter
|
||||
ref.cast (ref $closure)
|
||||
local.get $f
|
||||
ref.as_non_null
|
||||
local.get $iter
|
||||
ref.cast (ref $closure)
|
||||
struct.get $closure 0
|
||||
call_ref $mlfun
|
||||
local.set $iter_print
|
||||
local.get $iter_print
|
||||
ref.cast (ref $closure)
|
||||
local.get $ltwo
|
||||
ref.as_non_null
|
||||
local.get $iter_print
|
||||
ref.cast (ref $closure)
|
||||
struct.get $closure 0
|
||||
call_ref $mlfun
|
||||
drop
|
||||
)
|
||||
(func $cl_f (param $env eqref) (param $x eqref) (result eqref)
|
||||
local.get $x
|
||||
ref.cast (ref i31)
|
||||
i31.get_u
|
||||
call $print_i32
|
||||
i32.const 0
|
||||
i31.new
|
||||
)
|
||||
(func $cl_iter_f (param $envtwo eqref) (param $l eqref) (result eqref) (local $x eqref) (local $f eqref) (local $dummy eqref) (local $tl eqref)
|
||||
(block $switch_a (result (ref null eq))
|
||||
(block $switch_b (result (ref null eq))
|
||||
local.get $l
|
||||
br_on_cast $switch_b (ref null eq) i31ref
|
||||
ref.cast (ref $block)
|
||||
struct.get $block 0
|
||||
global.set $tmp_switch_value
|
||||
global.get $tmp_switch_value
|
||||
i32.const 0
|
||||
i32.eq
|
||||
(if (result (ref null eq))
|
||||
(then
|
||||
local.get $l
|
||||
ref.cast (ref $block)
|
||||
struct.get $block 1
|
||||
ref.as_non_null
|
||||
i32.const 0
|
||||
array.get $data
|
||||
local.set $x
|
||||
local.get $envtwo
|
||||
ref.cast (ref $closure)
|
||||
struct.get $closure 1
|
||||
ref.as_non_null
|
||||
struct.get $set_of_closures 1
|
||||
global.get $var_offset_within_set_f
|
||||
array.get $vars
|
||||
local.set $f
|
||||
local.get $f
|
||||
ref.cast (ref $closure)
|
||||
local.get $x
|
||||
ref.as_non_null
|
||||
local.get $f
|
||||
ref.cast (ref $closure)
|
||||
struct.get $closure 0
|
||||
call_ref $mlfun
|
||||
local.set $dummy
|
||||
local.get $l
|
||||
ref.cast (ref $block)
|
||||
struct.get $block 1
|
||||
ref.as_non_null
|
||||
i32.const 1
|
||||
array.get $data
|
||||
local.set $tl
|
||||
local.get $envtwo
|
||||
ref.cast (ref $closure)
|
||||
local.get $tl
|
||||
ref.as_non_null
|
||||
local.get $envtwo
|
||||
ref.cast (ref $closure)
|
||||
struct.get $closure 0
|
||||
call_ref $mlfun
|
||||
)
|
||||
(else
|
||||
unreachable
|
||||
)
|
||||
)
|
||||
br $switch_a)
|
||||
ref.cast (ref i31)
|
||||
i31.get_s
|
||||
global.set $tmp_switch_value
|
||||
global.get $tmp_switch_value
|
||||
i32.const 0
|
||||
i32.eq
|
||||
(if (result (ref null eq))
|
||||
(then
|
||||
i32.const 0
|
||||
i31.new
|
||||
)
|
||||
(else
|
||||
unreachable
|
||||
)
|
||||
))
|
||||
)
|
||||
(func $cl_iter (param $env eqref) (param $f eqref) (result eqref) (local $otherset eqref)
|
||||
ref.null $closures
|
||||
local.get $f
|
||||
ref.as_non_null
|
||||
array.new_fixed $vars 1
|
||||
struct.new $set_of_closures
|
||||
global.set $tmp_set_of_closures
|
||||
global.get $tmp_set_of_closures
|
||||
ref.func $cl_iter_f
|
||||
global.get $tmp_set_of_closures
|
||||
struct.new $closure
|
||||
array.new_fixed $closures 1
|
||||
struct.set $set_of_closures 0
|
||||
global.get $tmp_set_of_closures
|
||||
local.set $otherset
|
||||
local.get $otherset
|
||||
ref.cast (ref $set_of_closures)
|
||||
struct.get $set_of_closures 0
|
||||
global.get $closure_offset_within_set_cl_iter_f
|
||||
array.get $closures
|
||||
)
|
||||
(export "start" (func $start))
|
||||
(start $start)
|
||||
)
|
||||
***
|
||||
module $wasocaml_generated_modul :
|
||||
import "spectest" "print_i32" : func func [i32] -> []
|
||||
export "start" : func func [] -> []
|
||||
2 : i32
|
||||
1 : i32
|
||||
Loading…
x
Reference in New Issue
Block a user