Applied this new way to check the errors in the main code

2 files changed, 65 insertions, 67 deletions

diff --git a/lib/syntax/check.ml b/lib/syntax/check.ml
index 5ef2621..3e9d255 100644
--- a/lib/syntax/check.ml
+++ b/lib/syntax/check.ml
@@ -45,7 +45,11 @@ end
     associate with. *)
 type result = R : { value : 'a; witness : 'a Id.typeid } -> result
 
-type transform =
+let get : type a. a Id.typeid -> result -> a option =
+ fun typeid (R { value; witness }) ->
+  match Id.try_cast typeid witness with Some Eq -> Some value | None -> None
+
+type t =
   | E : {
       module_ :
         (module S.Analyzer
@@ -56,10 +60,23 @@ type transform =
       instr_witness : 'b Id.typeid;
       location_witness : 'c Id.typeid;
     }
-      -> transform
+      -> t
+
+let build :
+    (module S.Analyzer
+       with type Expression.t = 'a
+        and type Instruction.t = 'b
+        and type Location.t = 'c) ->
+    'a Id.typeid * 'b Id.typeid * 'c Id.typeid * t =
+ fun module_ ->
+  let expr_witness = Id.newtype ()
+  and instr_witness = Id.newtype ()
+  and location_witness = Id.newtype () in
+  let t = E { module_; expr_witness; instr_witness; location_witness } in
+  (expr_witness, instr_witness, location_witness, t)
 
 module type App = sig
-  val t : transform array
+  val t : t array
 end
 
 module Helper = struct
@@ -78,10 +95,10 @@ module Helper = struct
     let result =
       List.fold_left args ~init:{ values = []; witness }
         ~f:(fun (type a) ({ values; witness } : a args_list) t : a args_list ->
-          let (R { value = value_1; witness = witness_1 }) = Array.get t i in
-          match Id.try_cast witness witness_1 with
+          match get witness (Array.get t i) with
           | None -> failwith "Does not match"
-          | Some Eq -> { values = (fun r -> (value_1, r)) :: values; witness })
+          | Some value_1 ->
+              { values = (fun r -> (value_1, r)) :: values; witness })
     in
     { result with values = result.values }
 
@@ -134,13 +151,10 @@ module Make (A : App) = struct
       let report = ref report in
       let results =
         Array.map2 A.t results
-          ~f:(fun
-              (E { module_ = (module S); expr_witness; _ })
-              (R { value; witness })
-            ->
-            match Id.try_cast witness expr_witness with
+          ~f:(fun (E { module_ = (module S); expr_witness; _ }) value ->
+            match get expr_witness value with
             | None -> failwith "Does not match"
-            | Some Eq ->
+            | Some value ->
                 (* Evaluate the single expression *)
                 let value, report' =
                   S.Expression.uoperator pos op (fun r -> (value, r)) !report
@@ -169,22 +183,20 @@ module Make (A : App) = struct
             let (E { module_ = (module S); expr_witness; _ }) =
               Array.get A.t i
             in
-            let (R { value = value_1; witness }) = Array.get expr1 i in
-            match Id.try_cast expr_witness witness with
-            | None -> failwith "Does not match"
-            | Some Eq -> (
-                let (R { value = value_2; witness }) = Array.get expr2 i in
-                match Id.try_cast expr_witness witness with
-                | None -> failwith "Does not match"
-                | Some Eq ->
-                    let value, r =
-                      S.Expression.boperator pos op
-                        (fun r -> (value_1, r))
-                        (fun r -> (value_2, r))
-                        !report
-                    in
-                    report := r;
-                    R { witness = expr_witness; value }))
+            match
+              ( get expr_witness (Array.get expr1 i),
+                get expr_witness (Array.get expr2 i) )
+            with
+            | Some value_1, Some value_2 ->
+                let value, r =
+                  S.Expression.boperator pos op
+                    (fun r -> (value_1, r))
+                    (fun r -> (value_2, r))
+                    !report
+                in
+                report := r;
+                R { witness = expr_witness; value }
+            | _ -> failwith "Does not match")
       in
 
       let results = take_arg expr1 expr2 in
@@ -240,11 +252,9 @@ module Make (A : App) = struct
                 report := r;
                 R { witness = expr_witness; value }
             | Some t -> (
-                let (R { value = value_1; witness }) = Array.get t i in
-
-                match Id.try_cast expr_witness witness with
+                match get expr_witness (Array.get t i) with
                 | None -> failwith "Does not match"
-                | Some Eq ->
+                | Some value_1 ->
                     let value, r =
                       S.Expression.ident
                         { pos; name; index = Some (fun r -> (value_1, r)) }
@@ -348,11 +358,10 @@ module Make (A : App) = struct
             let values =
               List.rev_map args_i.values ~f:(fun value r -> value r)
             in
-            let (R { value = label_i; witness }) = Array.get label i in
 
-            match Id.try_cast witness expr_witness with
+            match get expr_witness (Array.get label i) with
             | None -> failwith "Does not match"
-            | Some Eq ->
+            | Some label_i ->
                 let label_i r = S.Expression.v (label_i, r) in
                 let value, r =
                   S.Instruction.act pos ~label:label_i values !report
@@ -393,21 +402,18 @@ module Make (A : App) = struct
             let index_i =
               Option.map
                 (fun expression ->
-                  let (R { value; witness }) = Array.get expression i in
-
-                  match Id.try_cast witness expr_witness with
+                  match get expr_witness (Array.get expression i) with
                   | None -> failwith "Does not match"
-                  | Some Eq ->
+                  | Some value ->
                       let value r = A.Expression.v (value, r) in
                       value)
                 index
             in
             let variable = S.{ pos = var_pos; name; index = index_i } in
 
-            let (R { value; witness }) = Array.get expression i in
-            match Id.try_cast witness expr_witness with
+            match get expr_witness (Array.get expression i) with
             | None -> failwith "Does not match"
-            | Some Eq ->
+            | Some value ->
                 let value, r =
                   A.Instruction.assign pos variable op
                     (fun r -> A.Expression.v (value, r))
@@ -446,10 +452,9 @@ module Make (A : App) = struct
         ('c, a) S.clause =
      fun i instr_witness expr_witness f clause ->
       let pos_clause, expr_clause, ts = clause in
-      let (R { value; witness }) = Array.get expr_clause i in
-      match Id.try_cast witness expr_witness with
+      match get expr_witness (Array.get expr_clause i) with
       | None -> failwith "Does not match"
-      | Some Eq ->
+      | Some value ->
           let ts = Helper.args_i ts instr_witness i in
           let ts = List.rev_map ts.values ~f:(fun value r -> value r) in
           let clause = (pos_clause, f value, ts) in
diff --git a/lib/syntax/check.mli b/lib/syntax/check.mli
index 276e51f..c831b67 100644
--- a/lib/syntax/check.mli
+++ b/lib/syntax/check.mli
@@ -1,34 +1,27 @@
 module Id : sig
   type 'a typeid
   (** The type created on-the-fly. *)
-
-  val newtype : unit -> 'a typeid
-  (** Create a new instance of a dynamic type *)
-
-  type ('a, 'b) eq = Eq : ('a, 'a) eq
-
-  val try_cast : 'a typeid -> 'b typeid -> ('a, 'b) eq option
-  (** Compare two types using the Eq pattern *)
 end
 
-type transform =
-  | E : {
-      module_ :
-        (module S.Analyzer
-           with type Expression.t = 'a
-            and type Instruction.t = 'b
-            and type Location.t = 'c);
-      expr_witness : 'a Id.typeid;
-      instr_witness : 'b Id.typeid;
-      location_witness : 'c Id.typeid;
-    }
-      -> transform
+type t
+(** Type of check to apply *)
+
+val build :
+  (module S.Analyzer
+     with type Expression.t = 'a
+      and type Instruction.t = 'b
+      and type Location.t = 'c) ->
+  'a Id.typeid * 'b Id.typeid * 'c Id.typeid * t
+(** Build a new check from a module following S.Analyzer signature *)
 
 module type App = sig
-  val t : transform array
+  val t : t array
 end
 
-type result = R : { value : 'a; witness : 'a Id.typeid } -> result
+type result
+
+val get : 'a Id.typeid -> result -> 'a option
+(** Retrieve the information with the given type *)
 
 module Make (A : App) : sig
   include