Now I have the API I want. Everything is abstract in the type S.Analyzer

1 files changed, 138 insertions, 258 deletions

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)