From 6fd720c07e3e361932e01bfbdbe4637c8f610649 Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Sun, 4 Feb 2024 10:37:04 +0100
Subject: Added a general context for each test

---
 lib/syntax/check.ml | 60 +++++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 44 insertions(+), 16 deletions(-)

(limited to 'lib/syntax/check.ml')

diff --git a/lib/syntax/check.ml b/lib/syntax/check.ml
index 6737e80..a5db091 100644
--- a/lib/syntax/check.ml
+++ b/lib/syntax/check.ml
@@ -55,12 +55,14 @@ type t =
             and type Expression.t' = 'b
             and type Instruction.t = 'c
             and type Instruction.t' = 'd
-            and type Location.t = 'e);
+            and type Location.t = 'e
+            and type context = 'f);
       expr_witness : 'a Id.typeid;
       expr' : 'b Id.typeid;
       instr_witness : 'c Id.typeid;
       instr' : 'd Id.typeid;
       location_witness : 'e Id.typeid;
+      context : 'f Id.typeid;
     }
       -> t
 
@@ -70,16 +72,27 @@ let build :
         and type Expression.t' = _
         and type Instruction.t = _
         and type Instruction.t' = _
-        and type Location.t = 'a) ->
+        and type Location.t = 'a
+        and type context = _) ->
     'a Id.typeid * t =
  fun module_ ->
   let expr_witness = Id.newtype ()
   and expr' = Id.newtype ()
   and instr_witness = Id.newtype ()
   and instr' = Id.newtype ()
-  and location_witness = Id.newtype () in
+  and location_witness = Id.newtype ()
+  and context = Id.newtype () in
   let t =
-    E { module_; expr_witness; expr'; instr_witness; instr'; location_witness }
+    E
+      {
+        module_;
+        expr_witness;
+        expr';
+        instr_witness;
+        instr';
+        location_witness;
+        context;
+      }
   in
   (location_witness, t)
 
@@ -112,6 +125,17 @@ module Make (A : App) = struct
   let description = "Internal module"
   let active = ref false
 
+  type context = result Array.t
+  (** We associate each context from the differents test in an array. The
+      context for this module is a sort of context of contexts *)
+
+  (** Initialize each test, and keep the result in the context. *)
+  let initialize : unit -> context =
+   fun () ->
+    Array.map A.t ~f:(fun (E { module_ = (module S); context; _ }) ->
+        let value = S.initialize () in
+        R { value; witness = context })
+
   (* Global variable for the whole module *)
   let len = Array.length A.t
 
@@ -127,9 +151,7 @@ module Make (A : App) = struct
             List.map values
               ~f:
                 (T.map_litteral ~f:(fun expr ->
-                     match get expr_witness (Array.get expr i) with
-                     | None -> failwith "Does not match"
-                     | Some value -> value))
+                     Option.get (get expr_witness (Array.get expr i))))
           in
           let value = S.Expression.literal pos values' in
           R { value; witness = expr_witness })
@@ -305,9 +327,7 @@ module Make (A : App) = struct
           let index_i =
             Option.map
               (fun expression ->
-                match get expr' (Array.get expression i) with
-                | None -> failwith "Does not match"
-                | Some value -> value)
+                Option.get (get expr' (Array.get expression i)))
               index
           in
           let variable = S.{ pos = var_pos; name; index = index_i } in
@@ -385,23 +405,31 @@ module Make (A : App) = struct
   end
 
   module Location :
-    S.Location with type t = result array and type instruction = Instruction.t' =
-  struct
+    S.Location
+      with type t = result array
+       and type instruction = Instruction.t'
+       and type context := context = struct
     type instruction = Instruction.t'
     type t = result array
 
-    let location : S.pos -> instruction list -> t =
-     fun pos args ->
+    let location : context -> S.pos -> instruction list -> t =
+     fun local_context pos args ->
       ignore pos;
 
       let result =
         Array.init len ~f:(fun i ->
-            let (E { module_ = (module A); instr'; location_witness; _ }) =
+            let (E
+                  { module_ = (module A); instr'; location_witness; context; _ })
+                =
               Array.get A.t i
             in
 
+            let local_context =
+              Option.get (get context (Array.get local_context i))
+            in
+
             let instructions = List.rev (Helper.expr_i args instr' i).values in
-            let value = A.Location.location pos instructions in
+            let value = A.Location.location local_context pos instructions in
             R { value; witness = location_witness })
       in
       result
-- 
cgit v1.2.3