st/pass_strategy_synthesis
1
0
Fork 0
mirror of https://github.com/ProgramSnail/pass_strategy_synthesis.git synced 2026-01-25 04:47:09 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

fix build with ocanren syntax (with dune), separate functional and relational implementations

Browse source
This commit is contained in:
ProgramSnail 2026-01-09 19:41:39 +03:00
parent c72883f489
commit b8ea97d537
6 changed files with 367 additions and 316 deletions
Download patch file Download diff file Expand all files Collapse all files

2
bin/dune
View file

@ -8,6 +8,6 @@
(modules main) (modules main)
(flags (flags
(:standard -rectypes)) (:standard -rectypes))
(libraries lib1) ; (libraries ...)
(preprocess (preprocess
(pps OCanren-ppx.ppx_repr OCanren-ppx.ppx_fresh GT.ppx GT.ppx_all))) (pps OCanren-ppx.ppx_repr OCanren-ppx.ppx_fresh GT.ppx GT.ppx_all)))

66
lib/dune
View file

@ -3,38 +3,6 @@
(flags (flags
(:standard -warn-error +5)))) (:standard -warn-error +5))))
(library
(name lib1)
(modules lib)
(flags (-rectypes))
(libraries OCanren OCanren.tester)
(inline_tests)
(wrapped false)
(preprocess
(pps
OCanren-ppx.ppx_repr
OCanren-ppx.ppx_fresh
OCanren-ppx.ppx_distrib
GT.ppx
GT.ppx_all
ppx_inline_test)))
; (library
; (name lib2)
; (modules lib_next)
; (flags (-rectypes))
; (libraries OCanren OCanren.tester)
; (inline_tests)
; (wrapped false)
; (preprocess
; (pps
; OCanren-ppx.ppx_repr
; OCanren-ppx.ppx_fresh
; OCanren-ppx.ppx_distrib
; GT.ppx
; GT.ppx_all
; ppx_inline_test)))
(library (library
(name semantic_interpreter) (name semantic_interpreter)
(modules semantic_interpreter) (modules semantic_interpreter)
@ -51,3 +19,37 @@
GT.ppx_all GT.ppx_all
ppx_expect ppx_expect
ppx_inline_test))) ppx_inline_test)))
(library
(name relational_semantic_interpreter)
(modules relational_semantic_interpreter)
(flags
(:standard -rectypes))
(libraries OCanren OCanren.tester)
(preprocessor_deps %{project_root}/lib/pp5+gt+plugins+ocanren+dump.exe)
(inline_tests)
(wrapped false)
(preprocess
(pps
OCanren-ppx.ppx_repr
OCanren-ppx.ppx_distrib
OCanren-ppx.ppx_deriving_reify
OCanren-ppx.ppx_fresh
ppx_expect
ppx_inline_test
--
-pp
lib/pp5+gt+plugins+ocanren+dump.exe)
))
(rule
(targets pp5+gt+plugins+ocanren+dump.exe)
(action
(run
mkcamlp5.opt
-package
camlp5,camlp5.pa_o,camlp5.macro,camlp5.pr_dump,logger.syntax
-package
logger.syntax,GT.syntax,GT.syntax.all,OCanren.syntax
-o
%{targets})))

44
lib/relational_semantic_interpreter.ml Normal file
View file

@ -0,0 +1,44 @@
(* (,,) -< Pair.inj _ (Pair.inj _ _) *)
module Relational =
struct
open GT
open OCanren
open OCanren.Std
@type data_ground = Nat.ground with show, gmap
@type data_logic = Nat.logic with show, gmap
type data_injected = Nat.injected
@type tag_ground = Ref | Value with show, gmap
@type tag_logic = tag_ground logic with show, gmap
type tag_injected = tag_ground ilogic
@type ('d, 'dl) stmt_abs = Call of 'd * 'dl | Read of 'd | Write of 'd with show, gmap
@type stmt_ground = (data_ground, data_ground List.ground) stmt_abs with show, gmap
@type stmt_logic = (data_logic, data_logic List.logic) stmt_abs logic with show, gmap
type stmt_injected = (data_injected, data_injected List.injected) stmt_abs ilogic
@type body_ground = stmt_ground List.ground with show, gmap
@type body_logic = stmt_logic List.logic with show, gmap
type body_injected = stmt_injected List.injected
@type fun_decl_ground = tag_ground List.ground * body_ground with show, gmap
@type fun_decl_logic = (tag_logic List.logic * body_logic) logic with show, gmap
type fun_decl_injected = (tag_injected List.injected * body_injected) ilogic
@type prog_ground = fun_decl_ground List.ground * fun_decl_ground with show, gmap
@type prog_logic = (fun_decl_logic List.logic * fun_decl_logic) logic with show, gmap
type prog_injected = (fun_decl_injected List.injected * fun_decl_injected) ilogic
@type 'd arg_abs = RValue | LValue of 'd with show, gmap
@type arg_ground = data_ground arg_abs with show, gmap
@type arg_logic = data_logic arg_abs logic with show, gmap
type arg_injected = data_injected arg_abs ilogic
@type value_ground = UnitV | BotV with show, gmap
@type value_logic = value_ground logic with show, gmap
type value_injected = value_ground ilogic
(* ocanren type 'a lst = Nil | Cons of 'a * 'a lst *)
end

569
lib/semantic_interpreter.ml
View file

@ -1,316 +1,323 @@
open OCanren (* (,,) -< Pair.inj _ (Pair.inj _ _) *)
(* --- types --- *) module Functional =
struct
type data = int (* --- types --- *)
type tag = Ref | Value type data = int
type stmt = Call of data * data list | Read of data | Write of data
type body = stmt list type tag = Ref | Value
type stmt = Call of data * data list | Read of data | Write of data
type fun_decl = tag list * body type body = stmt list
type prog = fun_decl list * fun_decl type fun_decl = tag list * body
(* --- exceptions --- *) type prog = fun_decl list * fun_decl
exception Incorrect_memory_access of int (* --- exceptions --- *)
exception Ref_rvalue_argument of int
(* --- static interpreter (no rec) --- *) exception Incorrect_memory_access of int
exception Ref_rvalue_argument of int
module M = Map.Make (Int);; (* --- static interpreter (no rec) --- *)
type arg = RValue | LValue of data (* TODO: data in calls ?? *) module M = Map.Make (Int);;
type value = UnitV | BotV (* NOTE: RefV of data - not needed for now *)
(* env * memory * last unused memory * assignments *) (* TODO: allow data (rvalue) in calls ?? *)
type state = data M.t * value Array.t * int * data list type arg = RValue | LValue of data
type value = UnitV | BotV (* NOTE: RefV of data - not needed for now *)
let rec list_replace xs id value = match (xs, id) with (* TODO: replace env map with pairs *)
| (x :: xs, 0) -> value :: xs (* env * memory * last unused memory * assignments *)
| (x :: xs, n) -> x :: list_replace xs (id - 1) value type state = data M.t * value list * int * data list
| ([], _) -> raise Not_found
(* TODO: replace with pairs *)
let rec list_replace xs id value = match (xs, id) with
| (_x :: xs, 0) -> value :: xs
| (x :: xs, _n) -> x :: list_replace xs (id - 1) value
| ([], _) -> raise Not_found
let env_get state id = match state with
(env, mem, mem_len, assignments) -> M.find id env
let env_add state id mem_id = match state with let env_get state id = match state with
(env, mem, mem_len, assignments) -> let env = M.add id mem_id env in (env, _mem, _mem_len, _assignments) -> M.find id env
(env, mem, mem_len, assignments)
let inv_id mem_len id = mem_len - id - 1 let env_add state id mem_id = match state with
(env, mem, mem_len, assignments) -> let env = M.add id mem_id env in
(env, mem, mem_len, assignments)
let mem_get state id = match state with let inv_id mem_len id = mem_len - id - 1
(env, mem, mem_len, _) -> List.nth mem @@ inv_id mem_len @@ env_get state id
let mem_set state id value= match state with let mem_get state id = match state with
(env, mem, mem_len, assignments) -> let mem_id = inv_id mem_len @@ env_get state id in (_env, mem, mem_len, _assignments) -> List.nth mem @@ inv_id mem_len @@ env_get state id
let mem = list_replace mem mem_id value in (env, mem, mem_len, id :: assignments)
let mem_add state value = match state with let mem_set state id value= match state with
(env, mem, mem_len, assignments) -> let mem = value :: mem in (env, mem, mem_len + 1, assignments) (env, mem, mem_len, assignments) -> let mem_id = inv_id mem_len @@ env_get state id in
let mem = list_replace mem mem_id value in (env, mem, mem_len, id :: assignments)
let mem_check state id = if mem_get state id == BotV then raise @@ Incorrect_memory_access id else state let mem_add state value = match state with
(env, mem, mem_len, assignments) -> let mem = value :: mem in (env, mem, mem_len + 1, assignments)
let mem_check state id = if mem_get state id == BotV then raise @@ Incorrect_memory_access id else state
let arg_to_value state arg = match arg with
| RValue -> UnitV
| LValue id -> mem_get state id
let st_mem_len state = let arg_to_value state arg = match arg with
match state with (_, _, mem_len, _) -> mem_len | RValue -> UnitV
| LValue id -> mem_get state id
let st_add_arg state state_before id arg_tag arg = let st_mem_len state =
(* match state with (env, mem, mem_len, assignments) -> *) match state with (_, _, mem_len, _) -> mem_len
match (arg_tag, arg) with
| (Ref, RValue) -> raise @@ Ref_rvalue_argument id (* TODO: allow later ?? *)
| (Ref, LValue arg) -> env_add state id (env_get state_before arg)
| (Value, arg) -> let state = mem_add state (arg_to_value state_before arg) in
let state = env_add state id (st_mem_len state - 1) in
state
let st_spoil_assignments state = let st_add_arg state state_before id arg_tag arg =
match state with (env, mem, mem_len, assignments) -> match (arg_tag, arg) with
(* TODO: use env var ids instead of mem_ids ?? *) | (Ref, RValue) -> raise @@ Ref_rvalue_argument id (* TODO: allow later ?? *)
(env, List.fold_left (fun mem id -> list_replace mem (inv_id mem_len @@ env_get state id) BotV) mem assignments, mem_len, []) | (Ref, LValue arg) -> env_add state id (env_get state_before arg)
| (Value, arg) -> let state = mem_add state (arg_to_value state_before arg) in
let state = env_add state id (st_mem_len state - 1) in
state
let rec eval_stmt state prog stmt = let st_spoil_assignments state =
match stmt with match state with (env, mem, mem_len, assignments) ->
| Call (f_id, args) -> eval_fun state prog (List.nth prog f_id) (List.map (fun arg -> LValue arg) args) (* TODO: use env var ids instead of mem_ids ?? *)
| Read id -> mem_check state id (env, List.fold_left (fun mem id -> list_replace mem (inv_id mem_len @@ env_get state id) BotV) mem assignments, mem_len, [])
| Write id -> mem_set state id UnitV
and eval_body state prog body = List.fold_left (fun state stmt -> eval_stmt state prog stmt) state body let rec eval_stmt state prog stmt =
match stmt with
| Call (f_id, args) -> eval_fun state prog (List.nth prog f_id) (List.map (fun arg -> LValue arg) args)
| Read id -> mem_check state id
| Write id -> mem_set state id UnitV
and eval_fun state prog decl args = and eval_body state prog body = List.fold_left (fun state stmt -> eval_stmt state prog stmt) state body
match decl with (arg_tags, body) ->
match state with (env_before, mem_before, len_before, assignments_before) as state_before ->
let state = (M.empty, mem_before, len_before, []) in
let (state, _) = List.fold_left2 (fun (state, id) arg_tag arg -> (st_add_arg state state_before id arg_tag arg, id + 1)) (state, 0) arg_tags args in
let state = eval_body state prog body in
let state = st_spoil_assignments state in
match state with (env, mem, len, assignments) ->
(env_before, List.drop (len - len_before) mem, len_before, assignments_before) (* TODO: save some assignments ?? *)
and eval_fun_empty_args state prog decl = and eval_fun state prog decl args =
match decl with (arg_tags, _) -> match decl with (arg_tags, body) ->
let args = List.map (fun _ -> RValue) arg_tags in match state with (env_before, mem_before, len_before, assignments_before) as state_before ->
eval_fun state prog decl args let state = (M.empty, mem_before, len_before, []) in
let (state, _) = List.fold_left2 (fun (state, id) arg_tag arg -> (st_add_arg state state_before id arg_tag arg, id + 1)) (state, 0) arg_tags args in
let state = eval_body state prog body in
let state = st_spoil_assignments state in
match state with (_env, mem, len, _assignments) ->
(env_before, List.drop (len - len_before) mem, len_before, assignments_before) (* TODO: save some assignments ?? *)
let empty_state = (M.empty, [], 0, []) and eval_fun_empty_args state prog decl =
match decl with (arg_tags, _) ->
let args = List.map (fun _ -> RValue) arg_tags in
eval_fun state prog decl args
let eval_prog (prog, main_decl) = ignore @@ eval_fun_empty_args empty_state prog main_decl let empty_state = (M.empty, [], 0, [])
(* tests *) let eval_prog (prog, main_decl) = ignore @@ eval_fun_empty_args empty_state prog main_decl
(* >> tests without functions *) (* tests *)
let%expect_test "empty" = (* >> tests without functions *)
eval_prog ([], ([], []));
Printf.printf "done!"; let%expect_test "empty" =
[%expect {| done! |}] eval_prog ([], ([], []));
Printf.printf "done!";
let%expect_test "ref param in main failure" = [%expect {| done! |}]
try (eval_prog ([], ([Ref], []));
[%expect.unreachable]) let%expect_test "ref param in main failure" =
with Ref_rvalue_argument id -> Printf.printf "%i" id; try (eval_prog ([], ([Ref], []));
[%expect {| 0 |}] [%expect.unreachable])
with Ref_rvalue_argument id -> Printf.printf "%i" id;
let%expect_test "read empty args" = [%expect {| 0 |}]
try (eval_prog ([], ([], [Read 0]));
[%expect.unreachable]) let%expect_test "read empty args" =
with Not_found -> Printf.printf "done!"; try (eval_prog ([], ([], [Read 0]));
[%expect {| done! |}] [%expect.unreachable])
with Not_found -> Printf.printf "done!";
let%expect_test "write empty args" = [%expect {| done! |}]
try (eval_prog ([], ([], [Write 0]));
[%expect.unreachable]) let%expect_test "write empty args" =
with Not_found -> Printf.printf "done!"; try (eval_prog ([], ([], [Write 0]));
[%expect {| done! |}] [%expect.unreachable])
with Not_found -> Printf.printf "done!";
let%expect_test "simple write" = [%expect {| done! |}]
eval_prog ([], ([Value], [Write 0]));
Printf.printf "done!"; let%expect_test "simple write" =
[%expect {| done! |}] eval_prog ([], ([Value], [Write 0]));
Printf.printf "done!";
let%expect_test "simple read" = (* NOTE: should not work with read-before-write check*) [%expect {| done! |}]
eval_prog ([], ([Value], [Read 0]));
Printf.printf "done!"; let%expect_test "simple read" = (* NOTE: should not work with read-before-write check*)
[%expect {| done! |}] eval_prog ([], ([Value], [Read 0]));
Printf.printf "done!";
let%expect_test "multiple read & write" = [%expect {| done! |}]
eval_prog ([], ([Value], [Write 0; Read 0; Write 0; Write 0; Read 0; Read 0]));
Printf.printf "done!"; let%expect_test "multiple read & write" =
[%expect {| done! |}] eval_prog ([], ([Value], [Write 0; Read 0; Write 0; Write 0; Read 0; Read 0]));
Printf.printf "done!";
let%expect_test "multiple read & write, multiple args" = [%expect {| done! |}]
eval_prog ([], ([Value; Value; Value], [Write 0; Read 0; Write 1; Write 0; Write 2; Read 1; Write 2; Read 0; Read 2]));
Printf.printf "done!"; let%expect_test "multiple read & write, multiple args" =
[%expect {| done! |}] eval_prog ([], ([Value; Value; Value], [Write 0; Read 0; Write 1; Write 0; Write 2; Read 1; Write 2; Read 0; Read 2]));
Printf.printf "done!";
let%expect_test "main, access out of range" = [%expect {| done! |}]
try(eval_prog ([], ([Value], [Write 0; Read 5 ]));
[%expect.unreachable]) let%expect_test "main, access out of range" =
with Not_found -> Printf.printf "done!"; try(eval_prog ([], ([Value], [Write 0; Read 5 ]));
[%expect {| done! |}] [%expect.unreachable])
with Not_found -> Printf.printf "done!";
let%expect_test "main, access out of range" = [%expect {| done! |}]
try(eval_prog ([], ([Value], [Write 0; Write 5 ]));
[%expect.unreachable]) let%expect_test "main, access out of range" =
with Not_found -> Printf.printf "done!"; try(eval_prog ([], ([Value], [Write 0; Write 5 ]));
[%expect {| done! |}] [%expect.unreachable])
with Not_found -> Printf.printf "done!";
(* >> tests with one function *) [%expect {| done! |}]
let%expect_test "simple function call with value arg" = (* >> tests with one function *)
eval_prog ([([Value], [Write 0; Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]) ]));
Printf.printf "done!"; let%expect_test "simple function call with value arg" =
[%expect {| done! |}] eval_prog ([([Value], [Write 0; Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]) ]));
Printf.printf "done!";
let%expect_test "simple function call with ref arg" = [%expect {| done! |}]
eval_prog ([([Ref], [Write 0; Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]) ]));
Printf.printf "done!"; let%expect_test "simple function call with ref arg" =
[%expect {| done! |}] eval_prog ([([Ref], [Write 0; Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]) ]));
Printf.printf "done!";
let%expect_test "function with value arg & read" = [%expect {| done! |}]
eval_prog ([([Value], [Write 0; Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]); Read 0 ]));
Printf.printf "done!"; let%expect_test "function with value arg & read" =
[%expect {| done! |}] eval_prog ([([Value], [Write 0; Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]); Read 0 ]));
Printf.printf "done!";
(* --- *) [%expect {| done! |}]
let%expect_test "function with ref arg & read" = (* --- *)
try (eval_prog ([([Ref], [Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]); Read 0 ]));
[%expect.unreachable]) let%expect_test "function with ref arg & read" =
with Incorrect_memory_access id -> Printf.printf "%i" id; try (eval_prog ([([Ref], [Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]); Read 0 ]));
[%expect {| 0 |}] [%expect.unreachable])
with Incorrect_memory_access id -> Printf.printf "%i" id;
let%expect_test "function with ref arg & call twice" = [%expect {| 0 |}]
try (eval_prog ([([Ref], [Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]); Call (0, [0]) ]));
[%expect.unreachable]) let%expect_test "function with ref arg & call twice" =
with Incorrect_memory_access id -> Printf.printf "%i" id; try (eval_prog ([([Ref], [Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]); Call (0, [0]) ]));
[%expect {| 0 |}] [%expect.unreachable])
with Incorrect_memory_access id -> Printf.printf "%i" id;
let%expect_test "function with ref arg, write first & call twice" = [%expect {| 0 |}]
eval_prog ([([Ref], [Write 0; Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]); Call (0, [0]) ]));
Printf.printf "done!"; let%expect_test "function with ref arg, write first & call twice" =
[%expect {| done! |}] eval_prog ([([Ref], [Write 0; Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]); Call (0, [0]) ]));
Printf.printf "done!";
let%expect_test "function with ref arg & read, write" = [%expect {| done! |}]
try (eval_prog ([([Ref], [Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]); Read 0; Write 0 ]));
[%expect.unreachable]) let%expect_test "function with ref arg & read, write" =
with Incorrect_memory_access id -> Printf.printf "%i" id; try (eval_prog ([([Ref], [Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]); Read 0; Write 0 ]));
[%expect {| 0 |}] [%expect.unreachable])
with Incorrect_memory_access id -> Printf.printf "%i" id;
let%expect_test "function with ref arg & write, read" = [%expect {| 0 |}]
eval_prog ([([Ref], [Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]); Write 0; Read 0 ]));
Printf.printf "done!"; let%expect_test "function with ref arg & write, read" =
[%expect {| done! |}] eval_prog ([([Ref], [Read 0; Write 0])], ([Value], [Write 0; Call (0, [0]); Write 0; Read 0 ]));
Printf.printf "done!";
let%expect_test "function with ref arg, no write inside & read" = [%expect {| done! |}]
eval_prog ([([Ref], [Read 0; Read 0])], ([Value], [Write 0; Call (0, [0]); Read 0 ]));
Printf.printf "done!"; let%expect_test "function with ref arg, no write inside & read" =
[%expect {| done! |}] eval_prog ([([Ref], [Read 0; Read 0])], ([Value], [Write 0; Call (0, [0]); Read 0 ]));
Printf.printf "done!";
(* --- *) [%expect {| done! |}]
let%expect_test "function with value arg, read out of range" = (* --- *)
try(eval_prog ([([Value], [Read 0; Read 1])], ([Value; Value], [Write 0; Call (0, [0]); Read 0 ]));
[%expect.unreachable]) let%expect_test "function with value arg, read out of range" =
with Not_found -> Printf.printf "done!"; try(eval_prog ([([Value], [Read 0; Read 1])], ([Value; Value], [Write 0; Call (0, [0]); Read 0 ]));
[%expect {| done! |}] [%expect.unreachable])
with Not_found -> Printf.printf "done!";
let%expect_test "function with ref arg, read out of range" = [%expect {| done! |}]
try(eval_prog ([([Ref], [Read 0; Read 1])], ([Value; Value], [Write 0; Call (0, [0]); Read 0 ]));
[%expect.unreachable]) let%expect_test "function with ref arg, read out of range" =
with Not_found -> Printf.printf "done!"; try(eval_prog ([([Ref], [Read 0; Read 1])], ([Value; Value], [Write 0; Call (0, [0]); Read 0 ]));
[%expect {| done! |}] [%expect.unreachable])
with Not_found -> Printf.printf "done!";
let%expect_test "function with value arg, write out of range" = [%expect {| done! |}]
try(eval_prog ([([Value], [Read 0; Write 1])], ([Value; Value], [Write 0; Call (0, [0]); Read 0 ]));
[%expect.unreachable]) let%expect_test "function with value arg, write out of range" =
with Not_found -> Printf.printf "done!"; try(eval_prog ([([Value], [Read 0; Write 1])], ([Value; Value], [Write 0; Call (0, [0]); Read 0 ]));
[%expect {| done! |}] [%expect.unreachable])
with Not_found -> Printf.printf "done!";
let%expect_test "function with value arg, call out of range" = [%expect {| done! |}]
try(eval_prog ([([Value], [Read 0])], ([Value; Value], [Write 0; Call (0, [2]); Read 0 ]));
[%expect.unreachable]) let%expect_test "function with value arg, call out of range" =
with Not_found -> Printf.printf "done!"; try(eval_prog ([([Value], [Read 0])], ([Value; Value], [Write 0; Call (0, [2]); Read 0 ]));
[%expect {| done! |}] [%expect.unreachable])
with Not_found -> Printf.printf "done!";
(* --- *) [%expect {| done! |}]
let%expect_test "function with ref & value args, no write inside & read" = (* --- *)
eval_prog (
[([Ref; Value], [Read 0; Read 1])], let%expect_test "function with ref & value args, no write inside & read" =
([Value; Value], [Write 0; Write 1; Call (0, [0; 1]); Read 0; Read 1 ])); eval_prog (
Printf.printf "done!"; [([Ref; Value], [Read 0; Read 1])],
[%expect {| done! |}] ([Value; Value], [Write 0; Write 1; Call (0, [0; 1]); Read 0; Read 1 ]));
Printf.printf "done!";
let%expect_test "function with ref & value args, write value inside & read" = [%expect {| done! |}]
eval_prog (
[([Ref; Value], [Read 0; Read 1; Write 1; Read 1])], let%expect_test "function with ref & value args, write value inside & read" =
([Value; Value], [Write 0; Write 1; Call (0, [0; 1]); Read 0; Read 1 ])); eval_prog (
Printf.printf "done!"; [([Ref; Value], [Read 0; Read 1; Write 1; Read 1])],
[%expect {| done! |}] ([Value; Value], [Write 0; Write 1; Call (0, [0; 1]); Read 0; Read 1 ]));
Printf.printf "done!";
let%expect_test "function with ref & value args, write both inside & read" = [%expect {| done! |}]
try (eval_prog (
[([Ref; Value],[Read 0; Read 1; Write 0; Write 1; Read 1])], let%expect_test "function with ref & value args, write both inside & read" =
([Value; Value], [Write 0; Write 1; Call (0, [0; 1]); Read 0; Read 1 ])); try (eval_prog (
[%expect.unreachable]) [([Ref; Value],[Read 0; Read 1; Write 0; Write 1; Read 1])],
with Incorrect_memory_access id -> Printf.printf "%i" id; ([Value; Value], [Write 0; Write 1; Call (0, [0; 1]); Read 0; Read 1 ]));
[%expect {| 0 |}] [%expect.unreachable])
with Incorrect_memory_access id -> Printf.printf "%i" id;
(* --- *) [%expect {| 0 |}]
(* NOTE: maybe important case in the future *) (* --- *)
let%expect_test "function with ref two same ref args, read both & read" =
eval_prog ( (* NOTE: maybe important case in the future *)
[([Ref; Ref],[Read 0; Read 1; Read 1])], let%expect_test "function with ref two same ref args, read both & read" =
([Value], [Write 0; Call (0, [0; 0]); Read 0 ])); eval_prog (
Printf.printf "done!"; [([Ref; Ref],[Read 0; Read 1; Read 1])],
[%expect {| done! |}] ([Value], [Write 0; Call (0, [0; 0]); Read 0 ]));
Printf.printf "done!";
(* NOTE: maybe important case in the future *) [%expect {| done! |}]
let%expect_test "function with ref two same ref args, read both & nothing" =
eval_prog ( (* NOTE: maybe important case in the future *)
[([Ref; Ref],[Read 0; Read 1; Write 0; Write 1; Read 1])], let%expect_test "function with ref two same ref args, read both & nothing" =
([Value], [Write 0; Call (0, [0; 0]); ])); eval_prog (
Printf.printf "done!"; [([Ref; Ref],[Read 0; Read 1; Write 0; Write 1; Read 1])],
[%expect {| done! |}] ([Value], [Write 0; Call (0, [0; 0]); ]));
Printf.printf "done!";
(* >> tests with several functions *) [%expect {| done! |}]
let%expect_test "two functions with ref arg, read func -> write func" = (* >> tests with several functions *)
eval_prog (
[([Ref], [Read 0]); ([Ref], [Write 0])], let%expect_test "two functions with ref arg, read func -> write func" =
([Value], [Write 0; Call (0, [0]); Read 0; Call (1, [0]) ])); eval_prog (
Printf.printf "done!"; [([Ref], [Read 0]); ([Ref], [Write 0])],
[%expect {| done! |}] ([Value], [Write 0; Call (0, [0]); Read 0; Call (1, [0]) ]));
Printf.printf "done!";
let%expect_test "two functions with ref arg, write func -> read func" = [%expect {| done! |}]
try (eval_prog (
[([Ref], [Read 0]); ([Ref], [Write 0])], let%expect_test "two functions with ref arg, write func -> read func" =
([Value], [Write 0; Call (1, [0]); Call (0, [0]) ])); try (eval_prog (
[%expect.unreachable]) [([Ref], [Read 0]); ([Ref], [Write 0])],
with Incorrect_memory_access id -> Printf.printf "%i" id; ([Value], [Write 0; Call (1, [0]); Call (0, [0]) ]));
[%expect {| 0 |}] [%expect.unreachable])
with Incorrect_memory_access id -> Printf.printf "%i" id;
let%expect_test "two functions: ref arg after value arg" = [%expect {| 0 |}]
eval_prog (
[([Ref], [Read 0; Write 0]); ([Value], [Read 0; Write 0])], let%expect_test "two functions: ref arg after value arg" =
([Value], [Write 0; Call (1, [0]); Read 0; Call (0, [0]) ])); eval_prog (
Printf.printf "done!"; [([Ref], [Read 0; Write 0]); ([Value], [Read 0; Write 0])],
[%expect {| done! |}] ([Value], [Write 0; Call (1, [0]); Read 0; Call (0, [0]) ]));
Printf.printf "done!";
let%expect_test "two functions: value arg after spoiled ref arg" = [%expect {| done! |}]
try (eval_prog (
[([Ref], [Read 0; Write 0]); ([Value], [Read 0; Write 0])], let%expect_test "two functions: value arg after spoiled ref arg" =
([Value], [Write 0; Call (0, [0]); Call (1, [0]) ])); try (eval_prog (
[%expect.unreachable]) [([Ref], [Read 0; Write 0]); ([Value], [Read 0; Write 0])],
with Incorrect_memory_access id -> Printf.printf "%i" id; ([Value], [Write 0; Call (0, [0]); Call (1, [0]) ]));
[%expect {| 0 |}] [%expect.unreachable])
with Incorrect_memory_access id -> Printf.printf "%i" id;
[%expect {| 0 |}]
end

2
test/dune
View file

@ -1,2 +0,0 @@
(test
(name test_pass_strategy_synthesis))

0
test/test_pass_strategy_synthesis.ml
View file