From 319c1e4474f4fefde688720b78e8abf315513a32 Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Wed, 25 Oct 2023 18:41:27 +0200
Subject: Now I have the API I want. Everything is abstract in the type
 S.Analyzer

---
 lib/qparser/analyzer.ml         |   1 -
 lib/qparser/parser.mly          |  15 +-
 lib/qparser/qsp_instruction.mly |  14 +-
 lib/syntax/S.ml                 |  70 ++-----
 lib/syntax/check.ml             | 396 ++++++++++++++--------------------------
 lib/syntax/dead_end.ml          |  91 +++++----
 lib/syntax/tree.ml              |  65 +++----
 lib/syntax/type_of.ml           |  71 ++++---
 8 files changed, 267 insertions(+), 456 deletions(-)

(limited to 'lib')

diff --git a/lib/qparser/analyzer.ml b/lib/qparser/analyzer.ml
index 06960f6..58a117f 100644
--- a/lib/qparser/analyzer.ml
+++ b/lib/qparser/analyzer.ml
@@ -36,7 +36,6 @@ let parse :
     in
 
     evaluation
-    |> Result.map (fun e -> e [])
     |> Result.map_error (fun e ->
            let message =
              match e.IncrementalParser.code with
diff --git a/lib/qparser/parser.mly b/lib/qparser/parser.mly
index d84e534..81b630a 100644
--- a/lib/qparser/parser.mly
+++ b/lib/qparser/parser.mly
@@ -5,21 +5,20 @@
     type action_block =
         { loc : Qsp_syntax.S.pos
         ; expression : 
-          Analyzer.Expression.t' * Qsp_syntax.Report.t list 
-        ; body : Analyzer.Instruction.t Qsp_syntax.S.repr list
+          Analyzer.Expression.t'
+        ; body : Analyzer.Instruction.t list
         ; pos : Qsp_syntax.S.pos
         ; clauses : (
             ( (Analyzer.Instruction.expression, Analyzer.Instruction.t) Qsp_syntax.S.clause list 
-            * (Qsp_syntax.S.pos *Analyzer.Instruction.t Qsp_syntax.S.repr list) option
+            * (Qsp_syntax.S.pos * Analyzer.Instruction.t list) option
             ) option )
         }
 
     module Helper = Qsp_syntax.S.Helper(Analyzer.Expression)
-    module HelperI = Qsp_syntax.S.Helper(Analyzer.Instruction)
 %}
 
 %parameter<Analyzer: Qsp_syntax.S.Analyzer>
-%start <(Analyzer.Location.t * Qsp_syntax.Report.t list) Qsp_syntax.S.repr>main
+%start <(Analyzer.Location.t * Qsp_syntax.Report.t list)>main
 %on_error_reduce expression instruction unary_operator assignation_operator
 
 %% 
@@ -31,7 +30,7 @@ main:
       instructions = line_statement*
       LOCATION_END
     { 
-        let instructions = List.map instructions ~f:(HelperI.v) in
+        let instructions = List.map instructions ~f:(Analyzer.Instruction.v) in
         Analyzer.Location.location $loc instructions
     }
 
@@ -75,7 +74,7 @@ line_statement:
       END TOKEN?
       line_sep
       { 
-        let expression = Helper.v' e in
+        let expression = Analyzer.Expression.v e in
         let clauses = match b with
         | None -> None
         | Some (elifs, clauses) -> 
@@ -84,7 +83,7 @@ line_statement:
             | _ -> 
               List.map elifs
               ~f:(fun ((pos:Qsp_syntax.S.pos), e, instructions) -> 
-                let e = Helper.v' e in
+                let e = Analyzer.Expression.v e in
                 (pos, e, instructions)
               )
 
diff --git a/lib/qparser/qsp_instruction.mly b/lib/qparser/qsp_instruction.mly
index e8f5a77..b7d2558 100644
--- a/lib/qparser/qsp_instruction.mly
+++ b/lib/qparser/qsp_instruction.mly
@@ -18,7 +18,7 @@ argument(X):
 %public inline_action:
     | a = onliner(ACT)
       { let loc, label, statements, _, _ = a in 
-        let label = Helper.v' label in
+        let label = Analyzer.Expression.v label in
         Analyzer.Instruction.act loc ~label statements
       }
     | a = onliner(IF)
@@ -30,7 +30,7 @@ argument(X):
           | Some instructions -> Some ($loc(else_opt), [ instructions ]) in
         Analyzer.Instruction.if_
             loc 
-            (loc_s, Helper.v' expr, statements) 
+            (loc_s, Analyzer.Expression.v expr, statements) 
             ~elifs
             ~else_
       }
@@ -42,21 +42,21 @@ argument(X):
 
         Analyzer.Instruction.if_
             loc 
-            (loc_s, Helper.v' expr, statements) 
+            (loc_s, Analyzer.Expression.v expr, statements) 
             ~elifs
             ~else_
       }
 single_instruction:
     | expr = expression
     { 
-        let expr = Helper.v' expr in
+        let expr = Analyzer.Expression.v expr in
         Analyzer.Instruction.expression expr
     }
     | e = let_assignation   { e }
     | k = keyword
       args = argument(expression)
     {
-        let args = List.map args ~f:(Helper.v') in
+        let args = List.map args ~f:(Analyzer.Expression.v) in
         Analyzer.Instruction.call $loc k args
     }
 
@@ -69,8 +69,8 @@ let_assignation:
       op = assignation_operator
       value = expression 
     { 
-        let variable = Helper.variable' variable
-        and value = Helper.v' value in
+        let variable = Helper.variable variable
+        and value = Analyzer.Expression.v value in
 
         Analyzer.Instruction.assign $loc variable op value
     }
diff --git a/lib/syntax/S.ml b/lib/syntax/S.ml
index b52365d..4a6b3e2 100644
--- a/lib/syntax/S.ml
+++ b/lib/syntax/S.ml
@@ -13,8 +13,6 @@
 
  *)
 
-type 'a repr = Report.t list -> 'a
-
 type pos = Lexing.position * Lexing.position
 (** Starting and ending position for the given location *)
 
@@ -24,7 +22,7 @@ type ('a, 'b) variable = { pos : 'a; name : string; index : 'b option }
 
     If missing, the index should be considered as [0].*)
 
-type ('a, 'b) clause = pos * 'a * 'b repr list
+type ('a, 'b) clause = pos * 'a * 'b list
 
 (** Represent the evaluation over an expression *)
 module type Expression = sig
@@ -34,7 +32,7 @@ module type Expression = sig
   type t'
   (** External type used outside of the module *)
 
-  val v : t -> t' * Report.t list
+  val v : t -> t'
   val ident : (pos, t) variable -> t
 
   (*
@@ -61,54 +59,50 @@ module type Instruction = sig
   type t'
   (** External type used outside of the module *)
 
-  val v : t -> t' * Report.t list
+  val v : t -> t'
 
   type expression
 
-  val call : pos -> T.keywords -> expression list -> t repr
+  val call : pos -> T.keywords -> expression list -> t
   (** Call for an instruction like [GT] or [*CLR] *)
 
-  val location : pos -> string -> t repr
+  val location : pos -> string -> t
   (** Label for a loop *)
 
-  val comment : pos -> t repr
+  val comment : pos -> t
   (** Comment *)
 
-  val expression : expression -> t repr
+  val expression : expression -> t
   (** Raw expression *)
 
   val if_ :
     pos ->
     (expression, t) clause ->
     elifs:(expression, t) clause list ->
-    else_:(pos * t repr list) option ->
-    t repr
+    else_:(pos * t list) option ->
+    t
 
-  val act : pos -> label:expression -> t repr list -> t repr
+  val act : pos -> label:expression -> t list -> t
 
   val assign :
     pos ->
     (pos, expression) variable ->
     T.assignation_operator ->
     expression ->
-    t repr
+    t
 end
 
 module type Location = sig
   type t
   type instruction
 
-  val location : pos -> instruction list -> (t * Report.t list) repr
+  val location : pos -> instruction list -> t * Report.t list
 end
 
 module type Analyzer = sig
   module Expression : Expression
-
-  module Instruction :
-    Instruction with type expression = Expression.t' * Report.t list
-
-  module Location :
-    Location with type instruction = (Instruction.t' * Report.t list) repr
+  module Instruction : Instruction with type expression = Expression.t'
+  module Location : Location with type instruction = Instruction.t'
 end
 
 (** Helper module used in order to convert elements from the differents
@@ -124,39 +118,11 @@ module Helper (E : sig
   type t'
   (** External type used outside of the module *)
 
-  val v : t -> t' * Report.t list
+  val v : t -> t'
 end) : sig
-  val v : E.t repr -> Report.t list -> E.t' * Report.t list
-  (** Convert an instruction from the internal representation *)
-
-  val v' : E.t -> E.t' * Report.t list
-  (** Convert an expression from the internal representation *)
-
-  val variable :
-    (pos, E.t) variable -> (pos, Report.t list -> E.t' * Report.t list) variable
-
-  val variable' : (pos, E.t) variable -> (pos, E.t' * Report.t list) variable
+  val variable : (pos, E.t) variable -> (pos, E.t') variable
   (** Convert a variable from the [Expression.t] into [Expression.t'] *)
 end = struct
-  let v : E.t repr -> Report.t list -> E.t' * Report.t list =
-   fun v report ->
-    let value = v report in
-    E.v value
-
-  let v' : E.t -> E.t' * Report.t list = fun v -> E.v v
-
-  let variable :
-      (pos, E.t) variable ->
-      (pos, Report.t list -> E.t' * Report.t list) variable =
-   fun variable ->
-    let v' : E.t -> Report.t list -> E.t' * Report.t list =
-     fun t report ->
-      ignore report;
-      E.v t
-    in
-
-    { variable with index = Option.map v' variable.index }
-
-  let variable' : (pos, E.t) variable -> (pos, E.t' * Report.t list) variable =
-   fun variable -> { variable with index = Option.map v' variable.index }
+  let variable : (pos, E.t) variable -> (pos, E.t') variable =
+   fun variable -> { variable with index = Option.map E.v variable.index }
 end
diff --git a/lib/syntax/check.ml b/lib/syntax/check.ml
index 10e4809..54eb295 100644
--- a/lib/syntax/check.ml
+++ b/lib/syntax/check.ml
@@ -59,9 +59,9 @@ type t =
             and type Instruction.t' = 'd
             and type Location.t = 'e);
       expr_witness : 'a Id.typeid;
-      expr' : ('b * Report.t list) Id.typeid;
+      expr' : 'b Id.typeid;
       instr_witness : 'c Id.typeid;
-      instr' : ('d * Report.t list) Id.typeid;
+      instr' : 'd Id.typeid;
       location_witness : 'e Id.typeid;
     }
       -> t
@@ -90,27 +90,6 @@ module type App = sig
 end
 
 module Helper = struct
-  type 'a args_list = { witness : 'a Id.typeid; values : 'a S.repr list }
-  (** This types helps the compiler to know which kind of arguments are hold
-        inside the list. This is just a list with the additionnal witness
-        information *)
-
-  (** Extract all the lines from the given module 
-
-      **Beware** The values are reversed. You should apply a List.rev if you
-      want to keep them in the same order than the modules to apply.
-    *)
-  let args_i : result array list -> 'a Id.typeid -> int -> 'a args_list =
-   fun args witness i ->
-    let result =
-      List.fold_left args ~init:{ values = []; witness }
-        ~f:(fun (type a) ({ values; witness } : a args_list) t : a args_list ->
-          match get witness (Array.get t i) with
-          | None -> failwith "Does not match"
-          | Some value_1 -> { values = (fun _ -> value_1) :: values; witness })
-    in
-    { result with values = result.values }
-
   type 'a expr_list = { witness : 'a Id.typeid; values : 'a list }
 
   let expr_i : result array list -> 'a Id.typeid -> int -> 'a expr_list =
@@ -123,11 +102,12 @@ module Helper = struct
           | Some value_1 -> { values = value_1 :: values; witness })
     in
     { result with values = result.values }
-
-  let map_args report args = List.map args ~f:(fun v -> v report)
 end
 
 module Make (A : App) = struct
+  (* Global variable for the whole module *)
+  let len = Array.length A.t
+
   module Expression : S.Expression with type t' = result array = struct
     type t = result array
     type t' = result array
@@ -172,51 +152,32 @@ module Make (A : App) = struct
       results
 
     (** Basically the same as uoperator, but operate over two operands instead
-        of a single one. 
-
-        In order to operate over the values (application, op1, op2) I’ve
-        written a function [take_arg] which works like a [Array.map3] *)
+        of a single one. *)
     let boperator : S.pos -> T.boperator -> t -> t -> t =
      fun pos op expr1 expr2 ->
-      let take_arg : result array -> result array -> result array =
-       fun expr1 expr2 ->
-        let len = Array.length A.t in
-        Array.init len ~f:(fun i ->
-            let (E { module_ = (module S); expr_witness; _ }) =
-              Array.get A.t i
-            in
-            match
-              ( get expr_witness (Array.get expr1 i),
-                get expr_witness (Array.get expr2 i) )
-            with
-            | Some value_1, Some value_2 ->
-                let value = S.Expression.boperator pos op value_1 value_2 in
-                R { witness = expr_witness; value }
-            | _ -> failwith "Does not match")
-      in
-
-      take_arg expr1 expr2
+      Array.init len ~f:(fun i ->
+          let (E { module_ = (module S); expr_witness; _ }) = Array.get A.t i in
+          match
+            ( get expr_witness (Array.get expr1 i),
+              get expr_witness (Array.get expr2 i) )
+          with
+          | Some value_1, Some value_2 ->
+              let value = S.Expression.boperator pos op value_1 value_2 in
+              R { witness = expr_witness; value }
+          | _ -> failwith "Does not match")
 
     (** Call a function. The functions list is hardcoded in lib/lexer.mll *)
     let function_ : S.pos -> T.function_ -> t list -> t =
      fun pos func args ->
-      let len = Array.length A.t in
-      let result =
-        Array.init len ~f:(fun i ->
-            let (E { module_ = (module S); expr_witness; _ }) =
-              Array.get A.t i
-            in
-            (* Extract the arguments for each module *)
-            let args_i = List.rev (Helper.expr_i args expr_witness i).values in
-            let value = S.Expression.function_ pos func args_i in
-            R { witness = expr_witness; value })
-      in
-      result
+      Array.init len ~f:(fun i ->
+          let (E { module_ = (module S); expr_witness; _ }) = Array.get A.t i in
+          (* Extract the arguments for each module *)
+          let args_i = List.rev (Helper.expr_i args expr_witness i).values in
+          let value = S.Expression.function_ pos func args_i in
+          R { witness = expr_witness; value })
 
     let ident : (S.pos, t) S.variable -> t =
      fun { pos : S.pos; name : string; index : t option } ->
-      let len = Array.length A.t in
-
       Array.init len ~f:(fun i ->
           let (E { module_ = (module S); expr_witness; _ }) = Array.get A.t i in
 
@@ -236,7 +197,7 @@ module Make (A : App) = struct
 
     (** Convert each internal represention for the expression into its external
         representation *)
-    let v : t -> t' * Report.t list =
+    let v : t -> t' =
      fun t ->
       let result =
         Array.map2 A.t t
@@ -247,101 +208,69 @@ module Make (A : App) = struct
                 let value = S.Expression.v value in
                 R { witness = expr'; value })
       in
-      (result, [])
+      result
   end
 
   module Instruction :
     S.Instruction
-      with type expression = Expression.t' * Report.t list
+      with type expression = Expression.t'
        and type t' = result array = struct
-    type expression = Expression.t' * Report.t list
+    type expression = Expression.t'
     type t = result array
     type t' = result array
 
-    let location : S.pos -> string -> t S.repr =
-     fun pos label report ->
-      let values =
-        Array.map A.t ~f:(fun (E { module_ = (module S); instr_witness; _ }) ->
-            let value = S.Instruction.location pos label report in
-            R { value; witness = instr_witness })
-      in
-      values
-
-    let comment : S.pos -> t S.repr =
-     fun pos report ->
-      let values =
-        Array.map A.t ~f:(fun (E { module_ = (module S); instr_witness; _ }) ->
-            let value = S.Instruction.comment pos report in
-            R { value; witness = instr_witness })
-      in
-      values
-
-    let expression : expression -> t S.repr =
-     fun expr report ->
-      let expr, _report = expr in
-      let results =
-        Array.map2 A.t expr
-          ~f:(fun
-              (E { module_ = (module S); instr_witness; expr'; _ }) result ->
-            match get expr' result with
-            | None -> failwith "Does not match"
-            | Some value ->
-                (* The evaluate the instruction *)
-                let value = S.Instruction.expression value report in
-                R { value; witness = instr_witness })
-      in
-      results
+    let location : S.pos -> string -> t =
+     fun pos label ->
+      Array.map A.t ~f:(fun (E { module_ = (module S); instr_witness; _ }) ->
+          let value = S.Instruction.location pos label in
+          R { value; witness = instr_witness })
+
+    let comment : S.pos -> t =
+     fun pos ->
+      Array.map A.t ~f:(fun (E { module_ = (module S); instr_witness; _ }) ->
+          let value = S.Instruction.comment pos in
+          R { value; witness = instr_witness })
+
+    let expression : expression -> t =
+     fun expr ->
+      Array.map2 A.t expr
+        ~f:(fun (E { module_ = (module S); instr_witness; expr'; _ }) result ->
+          match get expr' result with
+          | None -> failwith "Does not match"
+          | Some value ->
+              (* The evaluate the instruction *)
+              let value = S.Instruction.expression value in
+              R { value; witness = instr_witness })
 
-    let call : S.pos -> T.keywords -> expression list -> t S.repr =
-     fun pos keyword args report ->
+    let call : S.pos -> T.keywords -> expression list -> t =
+     fun pos keyword args ->
       (* The arguments are given like an array of array. Each expression is
          actually the list of each expression in the differents modules. *)
+      Array.init len ~f:(fun i ->
+          let (E { module_ = (module S); expr'; instr_witness; _ }) =
+            Array.get A.t i
+          in
 
-      (* Accumulate the results *)
-      let report, args =
-        List.fold_left_map args ~init:report ~f:(fun report (v, r) ->
-            (r @ report, v))
-      in
-
-      let len = Array.length A.t in
-      let result =
-        Array.init len ~f:(fun i ->
-            let (E { module_ = (module S); expr'; instr_witness; _ }) =
-              Array.get A.t i
-            in
-
-            let values = List.rev (Helper.expr_i args expr' i).values in
-
-            let value = S.Instruction.call pos keyword values report in
-            R { witness = instr_witness; value })
-      in
-      result
-
-    let act : S.pos -> label:expression -> t S.repr list -> t S.repr =
-     fun pos ~label instructions _report ->
-      let label, report = label in
-      let instructions = Helper.map_args report instructions in
-      let len = Array.length A.t in
+          let values = List.rev (Helper.expr_i args expr' i).values in
 
-      let result =
-        Array.init len ~f:(fun i ->
-            let (E { module_ = (module S); instr_witness; expr'; _ }) =
-              Array.get A.t i
-            in
-            let values =
-              List.rev (Helper.args_i instructions instr_witness i).values
-            in
-
-            match get expr' (Array.get label i) with
-            | None -> failwith "Does not match"
-            | Some label_i ->
-                let value =
-                  S.Instruction.act pos ~label:label_i values report
-                in
-                R { witness = instr_witness; value })
-      in
+          let value = S.Instruction.call pos keyword values in
+          R { witness = instr_witness; value })
 
-      result
+    let act : S.pos -> label:expression -> t list -> t =
+     fun pos ~label instructions ->
+      Array.init len ~f:(fun i ->
+          let (E { module_ = (module S); instr_witness; expr'; _ }) =
+            Array.get A.t i
+          in
+          let values =
+            List.rev (Helper.expr_i instructions instr_witness i).values
+          in
+
+          match get expr' (Array.get label i) with
+          | None -> failwith "Does not match"
+          | Some label_i ->
+              let value = S.Instruction.act pos ~label:label_i values in
+              R { witness = instr_witness; value })
 
     (* I think it’s one of the longest module I’ve ever written in OCaml… *)
 
@@ -350,131 +279,91 @@ module Make (A : App) = struct
         (S.pos, expression) S.variable ->
         T.assignation_operator ->
         expression ->
-        t S.repr =
-     fun pos { pos = var_pos; name; index } op expression _report ->
-      let expression, report = expression in
-      let report = ref report and len = Array.length A.t in
-
-      let index =
-        Option.map
-          (fun v ->
-            let v, r = v in
-            report := r;
-            v)
-          index
-      in
-
-      let result =
-        Array.init len ~f:(fun i ->
-            let (E { module_ = (module A); instr_witness; expr'; _ }) =
-              Array.get A.t i
-            in
-
-            let index_i =
-              Option.map
-                (fun expression ->
-                  match get expr' (Array.get expression i) with
-                  | None -> failwith "Does not match"
-                  | Some value -> value)
-                index
-            in
-            let variable = S.{ pos = var_pos; name; index = index_i } in
-
-            match get expr' (Array.get expression i) with
-            | None -> failwith "Does not match"
-            | Some value ->
-                let value =
-                  A.Instruction.assign pos variable op value !report
-                in
-
-                R { value; witness = instr_witness })
-      in
+        t =
+     fun pos { pos = var_pos; name; index } op expression ->
+      Array.init len ~f:(fun i ->
+          let (E { module_ = (module A); instr_witness; expr'; _ }) =
+            Array.get A.t i
+          in
+
+          let index_i =
+            Option.map
+              (fun expression ->
+                match get expr' (Array.get expression i) with
+                | None -> failwith "Does not match"
+                | Some value -> value)
+              index
+          in
+          let variable = S.{ pos = var_pos; name; index = index_i } in
+
+          match get expr' (Array.get expression i) with
+          | None -> failwith "Does not match"
+          | Some value ->
+              let value = A.Instruction.assign pos variable op value in
 
-      result
+              R { value; witness = instr_witness })
 
     (** Helper function used to prepare the clauses *)
-    let map_clause :
-        Report.t list ->
-        (expression, t) S.clause ->
-        Report.t list * (S.pos * Expression.t' * t list) =
-     fun _report clause ->
+    let map_clause : (expression, t) S.clause -> S.pos * Expression.t' * t list
+        =
+     fun clause ->
       let clause_pos, expression, t = clause in
-      let expression, report = expression in
-      let t =
-        List.map t ~f:(fun t ->
-            let t = t report in
-            t)
-      in
+      let expression = expression in
       let clause = (clause_pos, expression, t) in
-      (report, clause)
+      clause
 
     let rebuild_clause :
         type a b.
         int ->
         a Id.typeid ->
         b Id.typeid ->
-        (b -> 'c) ->
         S.pos * result array * result array list ->
-        ('c, a) S.clause =
-     fun i instr_witness expr' f clause ->
+        (b, a) S.clause =
+     fun i instr_witness expr' clause ->
       let pos_clause, expr_clause, ts = clause in
       match get expr' (Array.get expr_clause i) with
       | None -> failwith "Does not match"
       | Some value ->
-          let ts = Helper.args_i ts instr_witness i in
+          let ts = Helper.expr_i ts instr_witness i in
           let ts = List.rev ts.values in
-          let clause = (pos_clause, f value, ts) in
+          let clause = (pos_clause, value, ts) in
           clause
 
     let if_ :
         S.pos ->
         (expression, t) S.clause ->
         elifs:(expression, t) S.clause list ->
-        else_:(S.pos * t S.repr list) option ->
-        t S.repr =
-     fun pos clause ~elifs ~else_ report ->
+        else_:(S.pos * t list) option ->
+        t =
+     fun pos clause ~elifs ~else_ ->
       (* First, apply the report for all the instructions *)
-      let report, clause = map_clause report clause in
-
-      let report, elifs = List.fold_left_map elifs ~init:report ~f:map_clause in
-      let report, else_ =
+      let clause = map_clause clause and elifs = List.map elifs ~f:map_clause in
+      let else_ =
         match else_ with
-        | None -> (report, None)
-        | Some (pos, instructions) ->
-            let instructions = Helper.map_args report instructions in
-            (report, Some (pos, instructions))
-      in
-      let len = Array.length A.t in
-
-      let result =
-        Array.init len ~f:(fun i ->
-            let (E { module_ = (module A); instr_witness; expr'; _ }) =
-              Array.get A.t i
-            in
-
-            (* This function helps to build the expression in the clauses *)
-            let f = Fun.id in
-
-            let clause = rebuild_clause i instr_witness expr' f clause
-            and elifs =
-              List.map elifs ~f:(rebuild_clause i instr_witness expr' f)
-            and else_ =
-              match else_ with
-              | None -> None
-              | Some (pos, instructions) ->
-                  let elses = Helper.args_i instructions instr_witness i in
-                  Some (pos, List.rev elses.values)
-            in
-
-            let value = A.Instruction.if_ pos clause ~elifs ~else_ report in
-            R { value; witness = instr_witness })
+        | None -> None
+        | Some (pos, instructions) -> Some (pos, instructions)
       in
-
-      result
+      Array.init len ~f:(fun i ->
+          let (E { module_ = (module A); instr_witness; expr'; _ }) =
+            Array.get A.t i
+          in
+
+          let clause = rebuild_clause i instr_witness expr' clause
+          and elifs = List.map elifs ~f:(rebuild_clause i instr_witness expr')
+          and else_ =
+            match else_ with
+            | None -> None
+            | Some (pos, instructions) ->
+                let elses = Helper.expr_i instructions instr_witness i in
+                Some (pos, List.rev elses.values)
+          in
+
+          let value = A.Instruction.if_ pos clause ~elifs ~else_ in
+          R { value; witness = instr_witness })
 
     (** This code is almost a copy/paste from Expression.v but I did not found
         a way to factorize it. *)
-    let v : t -> t' * Report.t list =
+    let v : t -> t' =
      fun t ->
       let result =
         Array.map2 A.t t
@@ -486,38 +375,29 @@ module Make (A : App) = struct
                 let value = S.Instruction.v value in
                 R { witness = instr'; value })
       in
-      (result, [])
+      result
   end
 
   module Location :
-    S.Location
-      with type t = result array
-       and type instruction = (Instruction.t' * Report.t list) S.repr = struct
-    type instruction = (Instruction.t' * Report.t list) S.repr
+    S.Location with type t = result array and type instruction = Instruction.t' =
+  struct
+    type instruction = Instruction.t'
     type t = result array
 
-    let location : S.pos -> instruction list -> (t * Report.t list) S.repr =
-     fun pos instructions report ->
+    let location : S.pos -> instruction list -> t * Report.t list =
+     fun pos args ->
       ignore pos;
 
-      (* Extract the instructions and accumulate the result *)
-      let instructions = Helper.map_args report instructions in
-
-      let report, args =
-        List.fold_left_map instructions ~init:report ~f:(fun report (v, r) ->
-            (r @ report, v))
-      in
-
-      let report = ref report and len = Array.length A.t in
+      let report = ref [] in
       let result =
         Array.init len ~f:(fun i ->
             let (E { module_ = (module A); instr'; location_witness; _ }) =
               Array.get A.t i
             in
 
-            let instructions = List.rev (Helper.args_i args instr' i).values in
-            let value, re = A.Location.location pos instructions !report in
-            report := re;
+            let instructions = List.rev (Helper.expr_i args instr' i).values in
+            let value, re = A.Location.location pos instructions in
+            report := List.rev_append re !report;
             R { value; witness = location_witness })
       in
       (result, !report)
diff --git a/lib/syntax/dead_end.ml b/lib/syntax/dead_end.ml
index d1683cd..1240e72 100644
--- a/lib/syntax/dead_end.ml
+++ b/lib/syntax/dead_end.ml
@@ -10,11 +10,11 @@ module Expression = struct
     let default = ()
   end)
 
-  let v : t -> t' * Report.t list = fun () -> ((), [])
+  let v : t -> t' = fun () -> ()
 end
 
 module Instruction = struct
-  type expression = Expression.t' * Report.t list
+  type expression = Expression.t'
   type cause = Missing_else | Unchecked_path
 
   type state = {
@@ -24,7 +24,7 @@ module Instruction = struct
     pos : (cause * S.pos) option;
   }
 
-  type t = state * Report.t list
+  type t = state
   type t' = state
 
   (** For each instruction, return thoses two informations :
@@ -33,7 +33,7 @@ module Instruction = struct
       - the last instruction is a [gt]
 
     *)
-  let v : t -> t' * Report.t list = fun t -> t
+  let v : t -> t' = fun t -> t
 
   let default =
     {
@@ -44,36 +44,33 @@ module Instruction = struct
     }
 
   (** Call for an instruction like [GT] or [*CLR] *)
-  let call : S.pos -> T.keywords -> expression list -> t S.repr =
-   fun pos f _ report ->
+  let call : S.pos -> T.keywords -> expression list -> t =
+   fun pos f _ ->
     ignore pos;
     match f with
     | T.Goto | T.XGoto ->
-        ({ block_pos = pos; has_gt = true; is_gt = true; pos = None }, report)
-    | T.Gosub ->
-        ({ block_pos = pos; has_gt = false; is_gt = true; pos = None }, report)
-    | _ -> (default, report)
+        { block_pos = pos; has_gt = true; is_gt = true; pos = None }
+    | T.Gosub -> { block_pos = pos; has_gt = false; is_gt = true; pos = None }
+    | _ -> default
 
   (** Label for a loop *)
-  let location : S.pos -> string -> t S.repr =
-   fun _ _ report -> (default, report)
+  let location : S.pos -> string -> t = fun _ _ -> default
 
   (** Comment *)
-  let comment : S.pos -> t S.repr = fun _ report -> (default, report)
+  let comment : S.pos -> t = fun _ -> default
 
   (** Raw expression *)
-  let expression : expression -> t S.repr = fun _ report -> (default, report)
+  let expression : expression -> t = fun _ -> default
 
   (** The content of a block is very linear, I only need to check the last element *)
-  let check_block : S.pos -> t S.repr list -> t S.repr =
-   fun pos instructions report ->
+  let check_block : S.pos -> t list -> t =
+   fun pos instructions ->
     let last_element =
-      List.fold_left instructions ~init:(default, report)
-        ~f:(fun (t, report) instruction ->
-          let result, report = instruction report in
+      List.fold_left instructions ~init:default ~f:(fun t instruction ->
+          let result = instruction in
           let has_gt = result.has_gt || t.has_gt in
           let is_gt = result.is_gt || t.is_gt in
-          ({ result with block_pos = pos; is_gt; has_gt }, report))
+          { result with block_pos = pos; is_gt; has_gt })
     in
     last_element
 
@@ -81,27 +78,27 @@ module Instruction = struct
       S.pos ->
       (expression, t) S.clause ->
       elifs:(expression, t) S.clause list ->
-      else_:(S.pos * t S.repr list) option ->
-      t S.repr =
-   fun pos clause ~elifs ~else_ report ->
+      else_:(S.pos * t list) option ->
+      t =
+   fun pos clause ~elifs ~else_ ->
     (* For each block, evaluate the instructions *)
-    let report, res, has_gt, is_gt =
-      List.fold_left ~init:(report, [], false, false) (clause :: elifs)
-        ~f:(fun (report, acc, has_gt, is_gt) clause ->
+    let res, has_gt, is_gt =
+      List.fold_left ~init:([], false, false) (clause :: elifs)
+        ~f:(fun (acc, has_gt, is_gt) clause ->
           let pos, _, instructions = clause in
-          let clause_t, report = check_block pos instructions report in
+          let clause_t = check_block pos instructions in
           let has_gt = has_gt || clause_t.has_gt
           and is_gt = is_gt || clause_t.is_gt in
 
-          (report, (clause_t, pos) :: acc, has_gt, is_gt))
+          ((clause_t, pos) :: acc, has_gt, is_gt))
     in
 
-    let else_pos, else_block, report =
+    let else_pos, else_block =
       match else_ with
       | Some (pos, instructions) ->
-          let block, report = check_block pos instructions report in
-          (pos, block, report)
-      | None -> (pos, default, report)
+          let block = check_block pos instructions in
+          (pos, block)
+      | None -> (pos, default)
     in
     let has_gt = has_gt || else_block.has_gt
     and is_gt = is_gt || else_block.is_gt in
@@ -110,7 +107,7 @@ module Instruction = struct
 
     (* Check if one of the clauses already holds a dead end*)
     match List.find_opt res ~f:(fun (res, _) -> res.pos != None) with
-    | Some (v, _) -> (v, report)
+    | Some (v, _) -> v
     | None -> (
         match (is_gt, has_gt) with
         | _, true -> (
@@ -119,41 +116,37 @@ module Instruction = struct
             match List.find_opt blocks ~f:(fun (f, _) -> not f.is_gt) with
             | None ->
                 (* Every branch in the if is covered. It’s ok. *)
-                ({ default with block_pos = pos; is_gt; has_gt }, report)
+                { default with block_pos = pos; is_gt; has_gt }
             | Some (_, pos) ->
                 (* TODO check if [pos] is the whole block *)
                 let cause =
                   match else_ with None -> Missing_else | _ -> Unchecked_path
                 in
-                ( { default with block_pos = pos; pos = Some (cause, pos) },
-                  report ))
-        | _, _ -> ({ default with block_pos = pos; has_gt; is_gt }, report))
+                { default with block_pos = pos; pos = Some (cause, pos) })
+        | _, _ -> { default with block_pos = pos; has_gt; is_gt })
 
-  let act : S.pos -> label:expression -> t S.repr list -> t S.repr =
-   fun pos ~label expressions report ->
+  let act : S.pos -> label:expression -> t list -> t =
+   fun pos ~label expressions ->
     ignore label;
-    check_block pos expressions report
+    check_block pos expressions
 
   let assign :
       S.pos ->
       (S.pos, expression) S.variable ->
       T.assignation_operator ->
       expression ->
-      t S.repr =
-   fun _ _ _ _ report -> (default, report)
+      t =
+   fun _ _ _ _ -> default
 end
 
 module Location = struct
   type t = unit
-  type instruction = (Instruction.t' * Report.t list) S.repr
+  type instruction = Instruction.t'
 
-  let location : S.pos -> instruction list -> (t * Report.t list) S.repr =
-   fun _pos instructions report ->
+  let location : S.pos -> instruction list -> t * Report.t list =
+   fun _pos instructions ->
     ( (),
-      List.fold_left instructions ~init:report ~f:(fun report instruction ->
-          let t, r = instruction [] in
-
-          let report = List.rev_append r report in
+      List.fold_left instructions ~init:[] ~f:(fun report t ->
           match (t.Instruction.is_gt, t.Instruction.pos) with
           | false, Some (cause, value) ->
               ignore cause;
diff --git a/lib/syntax/tree.ml b/lib/syntax/tree.ml
index cf02bf6..d4af905 100644
--- a/lib/syntax/tree.ml
+++ b/lib/syntax/tree.ml
@@ -36,7 +36,7 @@ module Expression : S.Expression with type t' = S.pos Ast.expression = struct
   type t = S.pos Ast.expression
   type t' = t
 
-  let v : t -> t' * Report.t list = fun t -> (t, [])
+  let v : t -> t' = fun t -> t
   let integer : S.pos -> string -> t = fun pos i -> Ast.Integer (pos, i)
   let literal : S.pos -> string -> t = fun pos l -> Ast.Literal (pos, l)
 
@@ -59,78 +59,57 @@ end
 
 module Instruction :
   S.Instruction
-    with type expression = Expression.t' * Report.t list
+    with type expression = Expression.t'
      and type t' = S.pos Ast.statement = struct
   type t = S.pos Ast.statement
   type t' = t
 
-  let v : t -> t' * Report.t list = fun t -> (t, [])
+  let v : t -> t' = fun t -> t
 
-  type expression = Expression.t' * Report.t list
+  type expression = Expression.t'
 
-  let call : S.pos -> T.keywords -> expression list -> t S.repr =
-   fun pos name args _ ->
-    let args = List.map ~f:fst args in
-    Ast.Call (pos, name, args)
+  let call : S.pos -> T.keywords -> expression list -> t =
+   fun pos name args -> Ast.Call (pos, name, args)
 
-  let location : S.pos -> string -> t S.repr =
-   fun loc label _ -> Ast.Location (loc, label)
+  let location : S.pos -> string -> t =
+   fun loc label -> Ast.Location (loc, label)
 
-  let comment : S.pos -> t S.repr = fun pos _ -> Ast.Comment pos
-
-  let expression : expression -> t S.repr =
-   fun expr _ -> Ast.Expression (fst expr)
+  let comment : S.pos -> t = fun pos -> Ast.Comment pos
+  let expression : expression -> t = fun expr -> Ast.Expression expr
 
   let if_ :
       S.pos ->
       (expression, t) S.clause ->
       elifs:(expression, t) S.clause list ->
-      else_:(S.pos * t S.repr list) option ->
-      t S.repr =
-   fun pos predicate ~elifs ~else_ _ ->
-    let clause (pos, expr, repr) =
-      let repr = List.map ~f:(fun instr -> instr []) repr in
-      (pos, fst @@ expr, repr)
-    in
+      else_:(S.pos * t list) option ->
+      t =
+   fun pos predicate ~elifs ~else_ ->
+    let clause (pos, expr, repr) = (pos, expr, repr) in
     let elifs = List.map ~f:clause elifs
     and else_ =
-      match else_ with
-      | None -> []
-      | Some (_, instructions) ->
-          List.map ~f:(fun instr -> instr []) instructions
+      match else_ with None -> [] | Some (_, instructions) -> instructions
     in
 
     Ast.If { loc = pos; then_ = clause predicate; elifs; else_ }
 
-  let act : S.pos -> label:expression -> t S.repr list -> t S.repr =
-   fun pos ~label statements _ ->
-    let label = fst label
-    and statements = List.map ~f:(fun instr -> instr []) statements in
-    Ast.Act { loc = pos; label; statements }
+  let act : S.pos -> label:expression -> t list -> t =
+   fun pos ~label statements -> Ast.Act { loc = pos; label; statements }
 
   let assign :
       S.pos ->
       (S.pos, expression) S.variable ->
       T.assignation_operator ->
       expression ->
-      t S.repr =
-   fun pos_loc { pos; name; index } op expr _ ->
+      t =
+   fun pos_loc { pos; name; index } op expr ->
     (*let index = Option.map (fun i -> fst @@ Expression.observe (i [])) index*)
-    let index = Option.map fst index in
-    let expr = fst expr in
     Ast.Declaration (pos_loc, { pos; name; index }, op, expr)
 end
 
 module Location = struct
-  type instruction = (Instruction.t' * Report.t list) S.repr
+  type instruction = Instruction.t'
   type t = S.pos * S.pos Ast.statement list
 
-  let location : S.pos -> instruction list -> (t * Report.t list) S.repr =
-   fun pos block report ->
-    let report, block =
-      List.fold_left_map ~init:report block ~f:(fun report b ->
-          let v, report = b report in
-          (report, v))
-    in
-    ((pos, block), report)
+  let location : S.pos -> instruction list -> t * Report.t list =
+   fun pos block -> ((pos, block), [])
 end
diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml
index 683a27a..485fbe2 100644
--- a/lib/syntax/type_of.ml
+++ b/lib/syntax/type_of.ml
@@ -144,9 +144,9 @@ end
 module Expression = struct
   type state = { result : Helper.t; pos : S.pos; empty : bool }
   type t = state * Report.t list
-  type t' = state
+  type t' = state * Report.t list
 
-  let v : t -> t' * Report.t list = fun t -> t
+  let v : t -> t' = fun t -> t
 
   let arg_of_repr : state -> Helper.argument_repr =
    fun { result; pos; empty } ->
@@ -352,29 +352,26 @@ end
 
 module Instruction = struct
   type t = Report.t list
-  type t' = unit
+  type t' = Report.t list
 
-  let v : t -> t' * Report.t list = fun local_report -> ((), local_report)
+  let v : t -> t' = fun local_report -> local_report
 
-  type expression = Expression.t' * Report.t list
+  type expression = Expression.t'
 
   (** Call for an instruction like [GT] or [*CLR] *)
-  let call : S.pos -> T.keywords -> expression list -> t S.repr =
-   fun _pos _ expressions report ->
-    List.fold_left expressions ~init:report ~f:(fun acc a ->
+  let call : S.pos -> T.keywords -> expression list -> t =
+   fun _pos _ expressions ->
+    List.fold_left expressions ~init:[] ~f:(fun acc a ->
         let _, report = a in
         (List.rev_append report) acc)
 
-  let location : S.pos -> string -> t S.repr = fun _pos _ report -> report
+  let location : S.pos -> string -> t = fun _pos _ -> []
 
   (** Comment *)
-  let comment : S.pos -> t S.repr = fun _pos report -> report
+  let comment : S.pos -> t = fun _pos -> []
 
   (** Raw expression *)
-  let expression : expression -> t S.repr =
-   fun expression report ->
-    ignore report;
-    snd expression
+  let expression : expression -> t = fun expression -> snd expression
 
   (** Helper function used in the [if_] function. *)
   let fold_clause : t -> (expression, t) S.clause -> t =
@@ -386,37 +383,36 @@ module Instruction = struct
     List.fold_left instructions
       ~init:(r @ r2 @ report)
       ~f:(fun acc a ->
-        let report = a [] in
+        let report = a in
         (List.rev_append report) acc)
 
   let if_ :
       S.pos ->
       (expression, t) S.clause ->
       elifs:(expression, t) S.clause list ->
-      else_:(S.pos * t S.repr list) option ->
-      t S.repr =
-   fun _pos clause ~elifs ~else_ report ->
+      else_:(S.pos * t list) option ->
+      t =
+   fun _pos clause ~elifs ~else_ ->
     (* Traverse the whole block recursively *)
-    let report = fold_clause report clause in
+    let report = fold_clause [] clause in
     let report = List.fold_left elifs ~f:fold_clause ~init:report in
 
     match else_ with
     | None -> report
     | Some (_, instructions) ->
         List.fold_left instructions ~init:report ~f:(fun acc a ->
-            let report = a [] in
+            let report = a in
             (List.rev_append report) acc)
 
-  let act : S.pos -> label:expression -> t S.repr list -> t S.repr =
-   fun _pos ~label instructions report ->
-    let result, r = label in
-    let report = r @ report in
+  let act : S.pos -> label:expression -> t list -> t =
+   fun _pos ~label instructions ->
+    let result, report = label in
     let report =
       Helper.compare Helper.String (Expression.arg_of_repr result) report
     in
 
     List.fold_left instructions ~init:report ~f:(fun acc a ->
-        let report = a [] in
+        let report = a in
         (List.rev_append report) acc)
 
   let assign :
@@ -424,11 +420,11 @@ module Instruction = struct
       (S.pos, expression) S.variable ->
       T.assignation_operator ->
       expression ->
-      t S.repr =
-   fun pos variable _ expression report ->
-    let right_expression, r = expression in
+      t =
+   fun pos variable _ expression ->
+    let right_expression, report = expression in
     let expr1, report' = Expression.ident variable in
-    let report = report' @ r @ report in
+    let report = report' @ report in
     match right_expression.empty with
     | true -> report
     | false -> (
@@ -451,15 +447,14 @@ end
 
 module Location = struct
   type t = unit
-  type instruction = (Instruction.t' * Report.t list) S.repr
-
-  let location : S.pos -> instruction list -> (t * Report.t list) S.repr =
-   fun _pos instructions report ->
-    let (), report =
-      List.fold_left instructions ~init:((), report)
-        ~f:(fun ((), report) instruction ->
-          let _, report' = instruction [] in
-          ((), report' @ report))
+  type instruction = Instruction.t'
+
+  let location : S.pos -> instruction list -> t * Report.t list =
+   fun _pos instructions ->
+    let report =
+      List.fold_left instructions ~init:[] ~f:(fun report instruction ->
+          let report' = instruction in
+          report' @ report)
     in
     ((), report)
 end
-- 
cgit v1.2.3