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

1 files changed, 42 insertions, 49 deletions

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;