struct: fixes, ref memcopy test (need to copy due to new memory model), test from presentation

model_with_structures/analyzer.ml

@@ -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 (Rf, _), RefV _ -> (mem, v) *)
-    | RefT (Cp, t), RefV id -> let (mem', v') = valcopy mem (mem_get mem id) t in
+    | 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 *)

model_with_structures/model.typ

@@ -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],
+    name: [ new reference /* copy */ 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],
 
     $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$,
   )
 ))
 

model_with_structures/synthesizer.ml

@@ -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
+        { fresh v', mem_cp, v_cp, mem_add, id_add in
-            c == Cp &
+          (* c == Cp & *)
-            mem_geto mem id v' &
+          mem_geto mem id v' &
-            valcopyo mem v' tp' (Std.pair mem_cp v_cp) &
+          valcopyo mem v' tp' (Std.pair mem_cp v_cp) &
-            mem_addo mem_cp v_cp (Std.pair mem_add id_add) &
+          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 =/= ZeroMV | { u == ZeroMV & v =/= ZeroMV } } &
-        u =/= BotMV & v =/= BotMV & 
+        { 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 =/= ZeroWV | { u == ZeroWV & v =/= ZeroWV } } &
-        u =/= OneWV & v =/= OneWV & 
+        { 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 &

model_with_structures/tests_f.ml

@@ -28,17 +28,23 @@ open StEnv
 (* - shortcuts *)
 
 (* NOTE: redo with fold ?? *)
-let rec seqo stmts stmt' = ocanren {
+let seq_foldero stmt_acc stmt stmt_acc' = ocanren {
-    { stmts == [] & stmt' == SkipS } |
+    stmt_acc' == SeqS(stmt, stmt_acc)
-    { 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 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))))