From 75f3eabb46eded01460f7700a75d094100047438 Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Sat, 14 Dec 2024 23:06:12 +0100
Subject: Added dynamic check mecanism

---
 lib/checks/locations.ml | 51 +++++++++++++------------------------------------
 1 file changed, 13 insertions(+), 38 deletions(-)

(limited to 'lib/checks/locations.ml')

diff --git a/lib/checks/locations.ml b/lib/checks/locations.ml
index 8ee6ffa..8e5f500 100644
--- a/lib/checks/locations.ml
+++ b/lib/checks/locations.ml
@@ -74,7 +74,7 @@ let registerLocation : string -> t -> t =
   { calls; locations }
 
 (** The module Expression is pretty simple, we are only interrested by the
-    strings ( because only the first argument of [gt …] is read ). 
+    strings ( because only the first argument of [gt …] is read ).
 
     If the string is too much complex, we just ignore it. *)
 module Expression = struct
@@ -99,6 +99,18 @@ module Instruction = struct
 
   let v : t -> t' = Fun.id
 
+  include
+    Default.Instruction
+      (Expression)
+      (struct
+        type nonrec t = t
+
+        let default = Fun.id
+
+        let fold : t Seq.t -> t =
+         fun sequence t -> Seq.fold_left (fun acc t -> t acc) t sequence
+      end)
+
   (** Keep a track of every gt or gs instruction *)
   let call : S.pos -> T.keywords -> Expression.t' list -> t =
    fun pos fn args t ->
@@ -106,43 +118,6 @@ module Instruction = struct
     | T.Goto, Some dest :: _ -> registerCall pos dest t
     | T.Gosub, Some dest :: _ -> registerCall pos dest t
     | _ -> t
-
-  let location : S.pos -> string -> t = fun _ _ -> Fun.id
-  let comment : S.pos -> t = fun _ -> Fun.id
-  let expression : Expression.t' -> t = fun _ -> Fun.id
-
-  let if_ :
-      S.pos ->
-      (Expression.t', t) S.clause ->
-      elifs:(Expression.t', t) S.clause list ->
-      else_:(S.pos * t list) option ->
-      t =
-   fun _ clause ~elifs ~else_ t ->
-    let traverse_clause t clause =
-      let _, _, block = clause in
-      List.fold_left block ~init:t ~f:(fun t instruction -> instruction t)
-    in
-
-    let t = traverse_clause t clause in
-    let t = List.fold_left ~init:t ~f:traverse_clause elifs in
-    match else_ with
-    | None -> t
-    | Some (_, instructions) ->
-        List.fold_left instructions ~init:t ~f:(fun t instruction ->
-            instruction t)
-
-  let act : S.pos -> label:Expression.t' -> t list -> t =
-   fun _ ~label instructions t ->
-    ignore label;
-    List.fold_left instructions ~init:t ~f:(fun t instruction -> instruction t)
-
-  let assign :
-      S.pos ->
-      (S.pos, Expression.t') S.variable ->
-      T.assignation_operator ->
-      Expression.t' ->
-      t =
-   fun _ _ _ _ -> Fun.id
 end
 
 module Location = struct
-- 
cgit v1.2.3