mirror of
https://github.com/ProgramSnail/pass_strategy_synthesis.git
synced 2026-06-10 19:28:16 +00:00
struct: fixes, ref memcopy test (need to copy due to new memory model), test from presentation
This commit is contained in:
ProgramSnail
parent
1d65b67260
commit
0ef7ebdad2
5 changed files with 277 additions and 44 deletions
|
|
@ -200,8 +200,8 @@ struct
|
|||
| UnitT (Rd, _), UnitV (v_m, _, _) -> (mem, UnitV (v_m, ZeroRV, ZeroWV))
|
||||
| UnitT (NRd, _), UnitV _ -> (mem, UnitV (BotMV, ZeroRV, ZeroWV))
|
||||
| FunT _, FunV _ -> (mem, v)
|
||||
| RefT (Rf, _), RefV _ -> (mem, v)
|
||||
| RefT (Cp, t), RefV id -> let (mem', v') = valcopy mem (mem_get mem id) t in
|
||||
(* | RefT (Rf, _), RefV _ -> (mem, v) *)
|
||||
| RefT (_, t), RefV id -> let (mem', v') = valcopy mem (mem_get mem id) t in
|
||||
let (mem'', id'') = mem_add mem' v' in
|
||||
(mem'', RefV id'')
|
||||
| TupleT ts, TupleV vs -> let folder = fun (mem, vs') v t -> let (mem', v') = valcopy mem v t in
|
||||
|
|
@ -570,6 +570,7 @@ struct
|
|||
let vg8 = VarP (globals_min_id + 8)
|
||||
let vg9 = VarP (globals_min_id + 9)
|
||||
let vg10 = VarP (globals_min_id + 10)
|
||||
let vg11 = VarP (globals_min_id + 11)
|
||||
|
||||
let rf0E = RefE 0
|
||||
let rf1E = RefE 1
|
||||
|
|
@ -987,6 +988,72 @@ struct
|
|||
Printf.printf "done!";
|
||||
[%expect {| done! |}]
|
||||
|
||||
(* - tests for presentation *)
|
||||
|
||||
let%expect_test "presentation test 1 (simple types), dsl" =
|
||||
prog_eval_noret (
|
||||
[
|
||||
defgu uT_r_aw;
|
||||
defg (rfT uT_r_aw) rfg0E; (* x *)
|
||||
defgu uT_r_aw;
|
||||
defg (rfT uT_r_aw) rfg2E; (* y *)
|
||||
defgu uT_r_aw;
|
||||
defg (rfT uT_r_aw) rfg4E; (* z *)
|
||||
defgu uT_r_aw;
|
||||
defg (rfT uT_r_aw) rfg6E; (* k *)
|
||||
FunD ( (* f *)
|
||||
[
|
||||
(moded @@ rfT @@ uT_r_aw);
|
||||
(moded @@ rfT @@ uT_r);
|
||||
],
|
||||
(rdS @@ drf @@ v0) #.
|
||||
(wrS @@ drf @@ v0) #.
|
||||
(rdS @@ drf @@ v1)
|
||||
);
|
||||
FunD ( (* w *)
|
||||
[
|
||||
(moded @@ cpT @@ uT_mw);
|
||||
],
|
||||
(wrS @@ drf @@ v0) |. skp
|
||||
);
|
||||
FunD ( (* g *)
|
||||
[
|
||||
(moded @@ rfT @@ uT_aw);
|
||||
(moded @@ cpT @@ uT_r_mw);
|
||||
],
|
||||
(wrS @@ drf @@ v0) #.
|
||||
((wrS @@ drf @@ v1) |. (wrS @@ drf @@ v0)) #.
|
||||
(rdS @@ drf @@ v0) #.
|
||||
(rdS @@ drf @@ v1)
|
||||
);
|
||||
FunD ( (* r *)
|
||||
[
|
||||
(moded @@ rfT @@ uT_r);
|
||||
],
|
||||
(rdS @@ drf @@ v0)
|
||||
)
|
||||
],
|
||||
let xV = vg1 in
|
||||
let yV = vg3 in
|
||||
let zV = vg5 in
|
||||
let kV = vg7 in
|
||||
let fF = vg8 in
|
||||
let wF = vg9 in
|
||||
let gF = vg10 in
|
||||
let rF = vg11 in
|
||||
(callS wF [pE xV]) #.
|
||||
(callS rF [pE xV]) #.
|
||||
(callS fF [pE xV; pE yV]) #.
|
||||
(callS rF [pE yV]) #.
|
||||
(callS gF [pE zV; pE kV]) #.
|
||||
(wrS @@ drf @@ zV) #.
|
||||
(callS wF [pE zV]) #.
|
||||
(callS fF [pE yV; pE zV]) #.
|
||||
(callS rF [pE kV])
|
||||
);
|
||||
Printf.printf "done!";
|
||||
[%expect {| done! |}]
|
||||
|
||||
(* - complex tests *)
|
||||
|
||||
(* TODO: FIXME: rw tags *)
|
||||
|
|
|
|||
|
|
@ -13,7 +13,7 @@
|
|||
|
||||
== Syntax
|
||||
|
||||
*TODO: top-level value copy mode ??* // TODO: FIXME
|
||||
// *TODO: top-level value copy mode ??* // TODO: FIXME
|
||||
|
||||
*TODO: add formal global env to all types and vals (as in code) ??* // TODO: FIXME
|
||||
|
||||
|
|
@ -581,28 +581,26 @@ $s in stmt, f in X, x in X, a in X, p in path, pi in revpath$
|
|||
)
|
||||
))
|
||||
|
||||
// #align(center, prooftree(
|
||||
// vertical-spacing: 4pt,
|
||||
// rule(
|
||||
// name: [ new reference ref value],
|
||||
|
||||
// $cl rf l, mu cr xarrowSquiggly(rf Ref t)_new cl rf l, mu cr$,
|
||||
// )
|
||||
// ))
|
||||
|
||||
// NOTE: due to new memory cells types (with rw subcells) valnue should always be copied
|
||||
#align(center, prooftree(
|
||||
vertical-spacing: 4pt,
|
||||
rule(
|
||||
name: [ new reference ref value],
|
||||
|
||||
// TODO: FIXME: recursive copy ?? (what heppens if ref field has copy substructure ??)
|
||||
// <- forbidden ??
|
||||
|
||||
$cl rf l, mu cr xarrowSquiggly(rf Ref t)_new cl rf l, mu cr$,
|
||||
)
|
||||
))
|
||||
|
||||
#align(center, prooftree(
|
||||
vertical-spacing: 4pt,
|
||||
rule(
|
||||
name: [ new reference copy value],
|
||||
name: [ new reference /* copy */ value],
|
||||
|
||||
$cl mu[l], mu cr xarrowSquiggly(t)_new cl v, mu_v cr$,
|
||||
|
||||
$mu_v xarrowSquiggly(v)_#[add] cl l', mu_a cr$,
|
||||
|
||||
$cl rf l, mu cr xarrowSquiggly(rf Copy t)_new cl rf l', mu_a cr$,
|
||||
$cl rf l, mu cr xarrowSquiggly(rf c /*Copy*/ t)_new cl rf l', mu_a cr$,
|
||||
)
|
||||
))
|
||||
|
||||
|
|
|
|||
|
|
@ -592,7 +592,7 @@ struct
|
|||
let open Type in
|
||||
let open Value in
|
||||
let open ReadCap in
|
||||
let open CopyCap in
|
||||
(* let open CopyCap in *)
|
||||
let open MemVal in
|
||||
let open ReadVal in
|
||||
let open WriteVal in
|
||||
|
|
@ -613,13 +613,13 @@ struct
|
|||
{ fresh c, tp', id in
|
||||
v == RefV id &
|
||||
tp == RefT (c, tp') &
|
||||
{ { c == Rf & mem_with_id' == Std.pair mem v } |
|
||||
(* { c == Rf & mem_with_id' == Std.pair mem v } | *)
|
||||
{ fresh v', mem_cp, v_cp, mem_add, id_add in
|
||||
c == Cp &
|
||||
(* c == Cp & *)
|
||||
mem_geto mem id v' &
|
||||
valcopyo mem v' tp' (Std.pair mem_cp v_cp) &
|
||||
mem_addo mem_cp v_cp (Std.pair mem_add id_add) &
|
||||
mem_with_id' == (mem_add, RefV id_add) } } } |
|
||||
mem_with_id' == (mem_add, RefV id_add) } } |
|
||||
{ fresh vs, tps, mem', vs' in
|
||||
v == TupleV vs &
|
||||
tp == TupleT tps &
|
||||
|
|
@ -727,8 +727,8 @@ struct
|
|||
ocanren {
|
||||
{ u == ZeroMV & v == ZeroMV & u' == ZeroMV } |
|
||||
{ u == BotMV & v == BotMV & u' == BotMV } |
|
||||
{ u =/= ZeroMV & v =/= ZeroMV &
|
||||
u =/= BotMV & v =/= BotMV &
|
||||
{ { u =/= ZeroMV | { u == ZeroMV & v =/= ZeroMV } } &
|
||||
{ u =/= BotMV | { u == BotMV & v =/= BotMV } } &
|
||||
u' == SmthMV }
|
||||
}
|
||||
|
||||
|
|
@ -749,8 +749,8 @@ struct
|
|||
ocanren {
|
||||
{ u == OneWV & v == OneWV & u' == OneWV } |
|
||||
{ u == ZeroWV & v == ZeroWV & u' == ZeroWV } |
|
||||
{ u =/= ZeroWV & v =/= ZeroWV &
|
||||
u =/= OneWV & v =/= OneWV &
|
||||
{ { u =/= ZeroWV | { u == ZeroWV & v =/= ZeroWV } } &
|
||||
{ u =/= OneWV | { u == OneWV & v =/= OneWV } } &
|
||||
u' == SmthWV }
|
||||
}
|
||||
|
||||
|
|
@ -775,7 +775,8 @@ struct
|
|||
{ fresh a, b in
|
||||
u == RefV a &
|
||||
v == RefV b &
|
||||
a == b } |
|
||||
a == b &
|
||||
u' == RefV a } |
|
||||
{ fresh us, vs, us' in
|
||||
u == TupleV us &
|
||||
v == TupleV vs &
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
|
|
@ -28,17 +28,23 @@ open StEnv
|
|||
(* - shortcuts *)
|
||||
|
||||
(* NOTE: redo with fold ?? *)
|
||||
let rec seqo stmts stmt' = ocanren {
|
||||
{ stmts == [] & stmt' == SkipS } |
|
||||
{ fresh s in
|
||||
stmts == [s] &
|
||||
stmt' == s } |
|
||||
{ fresh s, s', ss, stmt_rest' in
|
||||
stmts == s :: s' :: ss &
|
||||
seqo (s' :: ss) stmt_rest' &
|
||||
stmt' == SeqS(s, stmt_rest')
|
||||
let seq_foldero stmt_acc stmt stmt_acc' = ocanren {
|
||||
stmt_acc' == SeqS(stmt, stmt_acc)
|
||||
}
|
||||
let seqo stmts stmt' = ocanren {
|
||||
list_foldro seq_foldero SkipS stmts stmt'
|
||||
}
|
||||
(* ocanren { *)
|
||||
(* { stmts == [] & stmt' == SkipS } | *)
|
||||
(* { fresh s in *)
|
||||
(* stmts == [s] & *)
|
||||
(* stmt' == s } | *)
|
||||
(* { fresh s, s', ss, stmt_rest' in *)
|
||||
(* stmts == s :: s' :: ss & *)
|
||||
(* seqo (s' :: ss) stmt_rest' & *)
|
||||
(* stmt' == SeqS(s, stmt_rest') *)
|
||||
(* } *)
|
||||
(* } *)
|
||||
|
||||
(* - basic var tests *)
|
||||
|
||||
|
|
@ -517,6 +523,155 @@ let prog_cp_cap_synt_t_simple_call_ref_fbd_wr' _ = show(answerCpCap) (Stream.tak
|
|||
prog_evalo prog st })
|
||||
(fun q -> q#reify (CopyCap.prj_exn))))
|
||||
|
||||
(* - presentation tests *)
|
||||
|
||||
let prog_eval_t_presentation_simple_tp _ = show(answer) (Stream.take (run q
|
||||
(fun q -> ocanren {
|
||||
fresh prog, xbg, xg,
|
||||
ybg, yg,
|
||||
zbg, zg,
|
||||
kbg, kg,
|
||||
fg, wg, gg, rg,
|
||||
xbd, xd,
|
||||
ybd, yd,
|
||||
zbd, zd,
|
||||
kbd, kd,
|
||||
fd, wd, gd, rd,
|
||||
fstmts, gstmts,
|
||||
stmts in
|
||||
globals_min_ido xbg &
|
||||
xg == Nat.s xbg &
|
||||
ybg == Nat.s xg &
|
||||
yg == Nat.s ybg &
|
||||
zbg == Nat.s yg &
|
||||
zg == Nat.s zbg &
|
||||
kbg == Nat.s zg &
|
||||
kg == Nat.s kbg &
|
||||
fg == Nat.s kg &
|
||||
wg == Nat.s fg &
|
||||
gg == Nat.s wg &
|
||||
rg == Nat.s gg &
|
||||
xbd == VarD (UnitT (Rd, AlwaysWr), UnitE) &
|
||||
xd == VarD (RefT (Rf, UnitT (Rd, AlwaysWr)), RefE xbg) &
|
||||
ybd == VarD (UnitT (Rd, AlwaysWr), UnitE) &
|
||||
yd == VarD (RefT (Rf, UnitT (Rd, AlwaysWr)), RefE ybg) &
|
||||
zbd == VarD (UnitT (Rd, AlwaysWr), UnitE) &
|
||||
zd == VarD (RefT (Rf, UnitT (Rd, AlwaysWr)), RefE zbg) &
|
||||
kbd == VarD (UnitT (Rd, AlwaysWr), UnitE) &
|
||||
kd == VarD (RefT (Rf, UnitT (Rd, AlwaysWr)), RefE kbg) &
|
||||
seqo [ReadS (DerefP (VarP 0));
|
||||
WriteS (DerefP (VarP 0));
|
||||
ReadS (DerefP (VarP 1))] fstmts &
|
||||
fd == FunD ([(Mode (In, NOut), RefT (Rf, UnitT (Rd, AlwaysWr)));
|
||||
(Mode (In, NOut), RefT (Rf, UnitT (Rd, NeverWr)))],
|
||||
fstmts) &
|
||||
wd == FunD ([(Mode (In, NOut), RefT (Cp, UnitT (NRd, MayWr)))],
|
||||
ChoiceS (WriteS (DerefP (VarP 0)), SkipS)) &
|
||||
seqo [WriteS (DerefP (VarP 0));
|
||||
ChoiceS (WriteS (DerefP (VarP 1)), WriteS (DerefP (VarP 0)));
|
||||
ReadS (DerefP (VarP 0));
|
||||
ReadS (DerefP (VarP 1))] gstmts &
|
||||
gd == FunD ([(Mode (In, NOut), RefT (Rf, UnitT (NRd, AlwaysWr)));
|
||||
(Mode (In, NOut), RefT (Cp, UnitT (Rd, MayWr)))],
|
||||
gstmts) &
|
||||
rd == FunD ([(Mode (In, NOut), RefT (Rf, UnitT (Rd, NeverWr)))],
|
||||
ReadS (DerefP (VarP 0))) &
|
||||
seqo [
|
||||
CallS (VarP wg, [PathE (VarP xg)]);
|
||||
CallS (VarP rg, [PathE (VarP xg)]);
|
||||
CallS (VarP fg, [PathE (VarP xg); PathE (VarP yg)]);
|
||||
CallS (VarP rg, [PathE (VarP yg)]);
|
||||
CallS (VarP gg, [PathE (VarP zg); PathE (VarP kg)]);
|
||||
CallS (VarP wg, [PathE (VarP zg)]);
|
||||
WriteS (DerefP (VarP zg));
|
||||
CallS (VarP fg, [PathE (VarP yg); PathE (VarP zg)]);
|
||||
CallS (VarP rg, [PathE (VarP kg)])
|
||||
] stmts &
|
||||
prog == Prg ([xbd; xd;
|
||||
ybd; yd;
|
||||
zbd; zd;
|
||||
kbd; kd;
|
||||
fd; wd; gd; rd],
|
||||
stmts) &
|
||||
prog_evalo prog q
|
||||
})
|
||||
(fun q -> q#reify (StEnv.prj_exn))))
|
||||
|
||||
let prog_synt_t_presentation_simple_tp _ = show(answerCpCapList) (Stream.take (run q
|
||||
(fun q -> ocanren {
|
||||
fresh prog, xbg, xg,
|
||||
ybg, yg,
|
||||
zbg, zg,
|
||||
kbg, kg,
|
||||
fg, wg, gg, rg,
|
||||
xbd, xd,
|
||||
ybd, yd,
|
||||
zbd, zd,
|
||||
kbd, kd,
|
||||
fd, wd, gd, rd,
|
||||
fstmts, gstmts,
|
||||
stmts,
|
||||
c_fx, c_fy, c_wx, c_gx, c_gy, c_rx,
|
||||
st in
|
||||
globals_min_ido xbg &
|
||||
xg == Nat.s xbg &
|
||||
ybg == Nat.s xg &
|
||||
yg == Nat.s ybg &
|
||||
zbg == Nat.s yg &
|
||||
zg == Nat.s zbg &
|
||||
kbg == Nat.s zg &
|
||||
kg == Nat.s kbg &
|
||||
fg == Nat.s kg &
|
||||
wg == Nat.s fg &
|
||||
gg == Nat.s wg &
|
||||
rg == Nat.s gg &
|
||||
xbd == VarD (UnitT (Rd, AlwaysWr), UnitE) &
|
||||
xd == VarD (RefT (Rf, UnitT (Rd, AlwaysWr)), RefE xbg) &
|
||||
ybd == VarD (UnitT (Rd, AlwaysWr), UnitE) &
|
||||
yd == VarD (RefT (Rf, UnitT (Rd, AlwaysWr)), RefE ybg) &
|
||||
zbd == VarD (UnitT (Rd, AlwaysWr), UnitE) &
|
||||
zd == VarD (RefT (Rf, UnitT (Rd, AlwaysWr)), RefE zbg) &
|
||||
kbd == VarD (UnitT (Rd, AlwaysWr), UnitE) &
|
||||
kd == VarD (RefT (Rf, UnitT (Rd, AlwaysWr)), RefE kbg) &
|
||||
seqo [ReadS (DerefP (VarP 0));
|
||||
WriteS (DerefP (VarP 0));
|
||||
ReadS (DerefP (VarP 1))] fstmts &
|
||||
fd == FunD ([(Mode (In, NOut), RefT (c_fx, UnitT (Rd, AlwaysWr)));
|
||||
(Mode (In, NOut), RefT (c_fy, UnitT (Rd, NeverWr)))],
|
||||
fstmts) &
|
||||
wd == FunD ([(Mode (In, NOut), RefT (c_wx, UnitT (NRd, MayWr)))],
|
||||
ChoiceS (WriteS (DerefP (VarP 0)), SkipS)) &
|
||||
seqo [WriteS (DerefP (VarP 0));
|
||||
ChoiceS (WriteS (DerefP (VarP 1)), WriteS (DerefP (VarP 0)));
|
||||
ReadS (DerefP (VarP 0));
|
||||
ReadS (DerefP (VarP 1))] gstmts &
|
||||
gd == FunD ([(Mode (In, NOut), RefT (c_gx, UnitT (NRd, AlwaysWr)));
|
||||
(Mode (In, NOut), RefT (c_gy, UnitT (Rd, MayWr)))],
|
||||
gstmts) &
|
||||
rd == FunD ([(Mode (In, NOut), RefT (c_rx, UnitT (Rd, NeverWr)))],
|
||||
ReadS (DerefP (VarP 0))) &
|
||||
seqo [
|
||||
CallS (VarP wg, [PathE (VarP xg)]);
|
||||
CallS (VarP rg, [PathE (VarP xg)]);
|
||||
CallS (VarP fg, [PathE (VarP xg); PathE (VarP yg)]);
|
||||
CallS (VarP rg, [PathE (VarP yg)]);
|
||||
CallS (VarP gg, [PathE (VarP zg); PathE (VarP kg)]);
|
||||
CallS (VarP wg, [PathE (VarP zg)]);
|
||||
WriteS (DerefP (VarP zg));
|
||||
CallS (VarP fg, [PathE (VarP yg); PathE (VarP zg)]);
|
||||
CallS (VarP rg, [PathE (VarP kg)])
|
||||
] stmts &
|
||||
prog == Prg ([xbd; xd;
|
||||
ybd; yd;
|
||||
zbd; zd;
|
||||
kbd; kd;
|
||||
fd; wd; gd; rd],
|
||||
stmts) &
|
||||
prog_evalo prog st &
|
||||
q == [c_fx; c_fy; c_wx; c_gx; c_gy; c_rx]
|
||||
})
|
||||
(fun q -> q#reify (List.prj_exn CopyCap.prj_exn))))
|
||||
|
||||
(* - complex tests *)
|
||||
|
||||
let deref_accesso id v p' = ocanren {
|
||||
|
|
@ -965,4 +1120,4 @@ let prog_synt_compl_test_send _ = show(answerCpCapList) (Stream.take (run q
|
|||
CallS (VarP send_allID, [PathE (VarP requestID)])
|
||||
) &
|
||||
prog_evalo prog st })
|
||||
(fun q -> q#reify (List.prj_exn CopyCap.prj_exn)))) (* TODO: list *)
|
||||
(fun q -> q#reify (List.prj_exn CopyCap.prj_exn))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue