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/default.ml | 84 ++++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 73 insertions(+), 11 deletions(-)

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

diff --git a/lib/checks/default.ml b/lib/checks/default.ml
index a2b53f6..0c4d761 100644
--- a/lib/checks/default.ml
+++ b/lib/checks/default.ml
@@ -1,25 +1,23 @@
-(** Default implementation which does nothing. 
+(** Default implementation which does nothing.
 
-This module is expected to be used when you only need to implement an analyze
-over a limited part of the whole syntax. *)
+    This module is expected to be used when you only need to implement an
+    analyze over a limited part of the whole syntax. *)
 
+open StdLabels
 module S = Qsp_syntax.S
 module T = Qsp_syntax.T
 module Report = Qsp_syntax.Report
 
-module type T = sig
+module Expression (T' : sig
   type t
 
   val default : t
-end
-
-module Expression (T' : T) = struct
-  (** 
-      Describe a variable, using the name in capitalized text, and an optionnal
+end) =
+struct
+  (** Describe a variable, using the name in capitalized text, and an optionnal
       index.
 
-      If missing, the index should be considered as [0].
-   *)
+      If missing, the index should be considered as [0]. *)
 
   type t' = T'.t
 
@@ -43,3 +41,67 @@ module Expression (T' : T) = struct
   let boperator : S.pos -> T.boperator -> T'.t -> T'.t -> T'.t =
    fun _ _ _ _ -> T'.default
 end
+
+module Instruction (Expression : sig
+  type t'
+end) (T : sig
+  type t
+
+  val default : t
+  val fold : t Seq.t -> t
+end) =
+struct
+  let call : S.pos -> Qsp_syntax.T.keywords -> Expression.t' list -> T.t =
+   fun _ _ _ -> T.default
+
+  let location : S.pos -> string -> T.t =
+   fun position name ->
+    ignore position;
+    ignore name;
+    T.default
+
+  let comment : S.pos -> T.t =
+   fun position ->
+    ignore position;
+    T.default
+
+  let expression : Expression.t' -> T.t =
+   fun expr ->
+    ignore expr;
+    T.default
+
+  let map_clause : (Expression.t', T.t) S.clause -> T.t Seq.t =
+   fun (_, _, els) -> List.to_seq els
+
+  let if_ :
+      S.pos ->
+      (Expression.t', T.t) S.clause ->
+      elifs:(Expression.t', T.t) S.clause list ->
+      else_:(S.pos * T.t list) option ->
+      T.t =
+   fun pos clause ~elifs ~else_ ->
+    ignore pos;
+
+    let seq = List.to_seq (clause :: elifs) |> Seq.flat_map map_clause in
+
+    let seq =
+      match else_ with
+      | None -> seq
+      | Some (_, ts) -> Seq.append seq (List.to_seq ts)
+    in
+    T.fold seq
+
+  let act : S.pos -> label:Expression.t' -> T.t list -> T.t =
+   fun pos ~label instructions ->
+    ignore pos;
+    ignore label;
+    T.fold (List.to_seq instructions)
+
+  let assign :
+      S.pos ->
+      (S.pos, Expression.t') S.variable ->
+      Qsp_syntax.T.assignation_operator ->
+      Expression.t' ->
+      T.t =
+   fun _ _ _ _ -> T.default
+end
-- 
cgit v1.2.3