From 8e88da289d5c96506a9540890ccbd7c22570049c Mon Sep 17 00:00:00 2001
From: Pierre-Marie Pédrot
Date: Fri, 20 Jul 2018 12:03:27 +0200
Subject: Fix #8043: Unsafe assignment in checker.

We use a dedicated mutable constructor to perform a Landin knot.
---
 checker/validate.ml |  1 +
 checker/values.ml   | 15 ++++++++++-----
 checker/values.mli  |  1 +
 3 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/checker/validate.ml b/checker/validate.ml
index f831875dd4..c214409a2c 100644
--- a/checker/validate.ml
+++ b/checker/validate.ml
@@ -85,6 +85,7 @@ let rec val_gen v ctx o = match v with
   | Fail s -> fail ctx o ("unexpected object " ^ s)
   | Annot (s,v) -> val_gen v (ctx/CtxAnnot s) o
   | Dyn -> val_dyn ctx o
+  | Proxy { contents = v } -> val_gen v ctx o
 
 (* Check that an object is a tuple (or a record). vs is an array of
    value representation for each field. Its size corresponds to the
diff --git a/checker/values.ml b/checker/values.ml
index 88cdb644db..d81b0f474a 100644
--- a/checker/values.ml
+++ b/checker/values.ml
@@ -45,6 +45,13 @@ type value =
   | String
   | Annot of string * value
   | Dyn
+  | Proxy of value ref
+
+let fix (f : value -> value) : value =
+  let self = ref Any in
+  let ans = f (Proxy self) in
+  let () = self := ans in
+  ans
 
 (** Some pseudo-constructors *)
 
@@ -352,18 +359,16 @@ let v_states = v_pair Any v_frozen
 let v_state = Tuple ("state", [|v_states; Any; v_bool|])
 
 let v_vcs =
-  let data = Opt Any in
-  let vcs =
+  let vcs self =
     Tuple ("vcs",
       [|Any; Any;
         Tuple ("dag",
           [|Any; Any; v_map Any (Tuple ("state_info",
-            [|Any; Any; Opt v_state; v_pair data Any|]))
+            [|Any; Any; Opt v_state; v_pair (Opt self) Any|]))
           |])
       |])
   in
-  let () = Obj.set_field (Obj.magic data) 0 (Obj.magic vcs) in
-  vcs
+  fix vcs
 
 let v_uuid = Any
 let v_request id doc =
diff --git a/checker/values.mli b/checker/values.mli
index 20b9d54a68..1b1437a469 100644
--- a/checker/values.mli
+++ b/checker/values.mli
@@ -20,6 +20,7 @@ type value =
   | String
   | Annot of string * value
   | Dyn
+  | Proxy of value ref
 
 val v_univopaques : value
 val v_libsum : value
-- 
cgit v1.2.3