From 180529c30282d39f3506633716e3fe439db03309 Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Fri, 3 Nov 2023 10:19:29 +0100
Subject: Extracting the report from the Location checker is now in it’s own
 function
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 lib/syntax/S.ml              |  3 ++-
 lib/syntax/check.ml          | 24 +++++++++++++++++++-----
 lib/syntax/dead_end.ml       | 35 ++++++++++++++++++-----------------
 lib/syntax/nested_strings.ml |  8 +++++---
 lib/syntax/tree.ml           |  4 ++--
 lib/syntax/type_of.ml        |  8 +++++---
 6 files changed, 51 insertions(+), 31 deletions(-)

(limited to 'lib/syntax')

diff --git a/lib/syntax/S.ml b/lib/syntax/S.ml
index f7c3ebe..972e405 100644
--- a/lib/syntax/S.ml
+++ b/lib/syntax/S.ml
@@ -96,7 +96,8 @@ module type Location = sig
   type t
   type instruction
 
-  val location : pos -> instruction list -> t * Report.t list
+  val v : t -> Report.t list
+  val location : pos -> instruction list -> t
 end
 
 (** {1 Unified module used by the parser } *)
diff --git a/lib/syntax/check.ml b/lib/syntax/check.ml
index 2528914..a7095fc 100644
--- a/lib/syntax/check.ml
+++ b/lib/syntax/check.ml
@@ -394,11 +394,10 @@ module Make (A : App) = struct
     type instruction = Instruction.t'
     type t = result array
 
-    let location : S.pos -> instruction list -> t * Report.t list =
+    let location : S.pos -> instruction list -> t =
      fun pos args ->
       ignore pos;
 
-      let report = ref [] in
       let result =
         Array.init len ~f:(fun i ->
             let (E { module_ = (module A); instr'; location_witness; _ }) =
@@ -406,10 +405,25 @@ module Make (A : App) = struct
             in
 
             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;
+            let value = A.Location.location pos instructions in
             R { value; witness = location_witness })
       in
-      (result, !report)
+      result
+
+    let v : t -> Report.t list =
+     fun args ->
+      let report = ref [] in
+      let () =
+        Array.iteri args ~f:(fun i result ->
+            let (E { module_ = (module A); location_witness; _ }) =
+              Array.get A.t i
+            in
+            match get location_witness result with
+            | None -> failwith "Does not match"
+            | Some value ->
+                let re = A.Location.v value in
+                report := List.rev_append re !report)
+      in
+      !report
   end
 end
diff --git a/lib/syntax/dead_end.ml b/lib/syntax/dead_end.ml
index 1240e72..042e640 100644
--- a/lib/syntax/dead_end.ml
+++ b/lib/syntax/dead_end.ml
@@ -140,24 +140,25 @@ module Instruction = struct
 end
 
 module Location = struct
-  type t = unit
+  type t = Report.t list
   type instruction = Instruction.t'
 
-  let location : S.pos -> instruction list -> t * Report.t list =
+  let v = Fun.id
+
+  let location : S.pos -> instruction list -> t =
    fun _pos instructions ->
-    ( (),
-      List.fold_left instructions ~init:[] ~f:(fun report t ->
-          match (t.Instruction.is_gt, t.Instruction.pos) with
-          | false, Some (cause, value) ->
-              ignore cause;
-              if t.Instruction.block_pos != value then
-                match cause with
-                | Missing_else ->
-                    Report.debug value "Possible dead end (no else fallback)"
-                    :: report
-                | Unchecked_path ->
-                    Report.warn value "Possible dead end (unmatched path)"
-                    :: report
-              else report
-          | _ -> report) )
+    List.fold_left instructions ~init:[] ~f:(fun report t ->
+        match (t.Instruction.is_gt, t.Instruction.pos) with
+        | false, Some (cause, value) ->
+            ignore cause;
+            if t.Instruction.block_pos != value then
+              match cause with
+              | Missing_else ->
+                  Report.debug value "Possible dead end (no else fallback)"
+                  :: report
+              | Unchecked_path ->
+                  Report.warn value "Possible dead end (unmatched path)"
+                  :: report
+            else report
+        | _ -> report)
 end
diff --git a/lib/syntax/nested_strings.ml b/lib/syntax/nested_strings.ml
index fb056d6..9d4867c 100644
--- a/lib/syntax/nested_strings.ml
+++ b/lib/syntax/nested_strings.ml
@@ -99,11 +99,13 @@ struct
 end
 
 module Location = struct
-  type t = unit
+  type t = Report.t list
   type instruction = Instruction.t'
 
-  let location : S.pos -> instruction list -> t * Report.t list =
+  let v = Fun.id
+
+  let location : S.pos -> instruction list -> t =
    fun pos intructions ->
     ignore pos;
-    ((), List.concat intructions)
+    List.concat intructions
 end
diff --git a/lib/syntax/tree.ml b/lib/syntax/tree.ml
index 34baae0..e70b66a 100644
--- a/lib/syntax/tree.ml
+++ b/lib/syntax/tree.ml
@@ -115,6 +115,6 @@ module Location = struct
   type instruction = Instruction.t'
   type t = S.pos * S.pos Ast.statement list
 
-  let location : S.pos -> instruction list -> t * Report.t list =
-   fun pos block -> ((pos, block), [])
+  let v _ = []
+  let location : S.pos -> instruction list -> t = fun pos block -> (pos, block)
 end
diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml
index ce04872..8f1c7ef 100644
--- a/lib/syntax/type_of.ml
+++ b/lib/syntax/type_of.ml
@@ -465,15 +465,17 @@ module Instruction = struct
 end
 
 module Location = struct
-  type t = unit
+  type t = Report.t list
   type instruction = Instruction.t'
 
-  let location : S.pos -> instruction list -> t * Report.t list =
+  let v = Fun.id
+
+  let location : S.pos -> instruction list -> t =
    fun _pos instructions ->
     let report =
       List.fold_left instructions ~init:[] ~f:(fun report instruction ->
           let report' = instruction in
           report' @ report)
     in
-    ((), report)
+    report
 end
-- 
cgit v1.2.3