zapashcanon
/
paper-wasocaml
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

add iter test

main
zapashcanon 1 year ago
parent
57f090da8e
commit
62d350f03d
Signed by: zapashcanon GPG Key ID: 8981C3C62D1D28F1
4 changed files with 341 additions and 0 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 1
      src/interpret.ml
  2. 1
      test/cram/dune
  3. 46
      test/cram/iter.flambda1
  4. 293
      test/cram/iter.t

1
src/interpret.ml
View File

@ -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)"

1
test/cram/dune
View File

@ -10,4 +10,5 @@
g.flambda1
h.flambda1
i.flambda1
iter.flambda1
w.flambda1))

46
test/cram/iter.flambda1
View 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
View 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
Write Preview
Loading…
Cancel
Save