From 62d350f03dfeeec96e1a48b8b5ad5b4783b70e0b Mon Sep 17 00:00:00 2001 From: zapashcanon Date: Tue, 1 Aug 2023 13:23:28 +0200 Subject: [PATCH] add iter test --- src/interpret.ml | 1 + test/cram/dune | 1 + test/cram/iter.flambda1 | 46 +++++++ test/cram/iter.t | 293 ++++++++++++++++++++++++++++++++++++++++ 4 files changed, 341 insertions(+) create mode 100644 test/cram/iter.flambda1 create mode 100644 test/cram/iter.t diff --git a/src/interpret.ml b/src/interpret.ml index b8f7999..0febfc5 100644 --- a/src/interpret.ml +++ b/src/interpret.ml @@ -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)" diff --git a/test/cram/dune b/test/cram/dune index 9ac3e1a..7cc7d9b 100644 --- a/test/cram/dune +++ b/test/cram/dune @@ -10,4 +10,5 @@ g.flambda1 h.flambda1 i.flambda1 + iter.flambda1 w.flambda1)) diff --git a/test/cram/iter.flambda1 b/test/cram/iter.flambda1 new file mode 100644 index 0000000..02381cc --- /dev/null +++ b/test/cram/iter.flambda1 @@ -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 diff --git a/test/cram/iter.t b/test/cram/iter.t new file mode 100644 index 0000000..97e69a2 --- /dev/null +++ b/test/cram/iter.t @@ -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