From 53c02501935b3cb2db78e79deb4d38c997505a95 Mon Sep 17 00:00:00 2001
From: Chimrod <>
Date: Mon, 2 Dec 2024 09:05:18 +0100
Subject: Moved the checks in a dedicated library

---
 lib/checks/nested_strings.ml | 159 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 159 insertions(+)
 create mode 100644 lib/checks/nested_strings.ml

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

diff --git a/lib/checks/nested_strings.ml b/lib/checks/nested_strings.ml
new file mode 100644
index 0000000..e4ffb68
--- /dev/null
+++ b/lib/checks/nested_strings.ml
@@ -0,0 +1,159 @@
+open StdLabels
+module S = Qsp_syntax.S
+module T = Qsp_syntax.T
+module Report = Qsp_syntax.Report
+
+let identifier = "escaped_string"
+let description = "Check for unnecessary use of expression encoded in string"
+let is_global = false
+let active = ref true
+
+type context = unit
+
+let initialize = Fun.id
+let finalize () = []
+
+module TypeBuilder = Compose.Expression (Get_type)
+
+module Expression = TypeBuilder.Make (struct
+  type t = Report.t list
+  type t' = Report.t list
+
+  let v : Get_type.t Lazy.t * t -> t' = snd
+
+  (** Identify the expressions reprented as string. That’s here that the report
+      are added. 
+
+      All the rest of the module only push thoses warning to the top level. *)
+  let literal :
+      S.pos -> (Get_type.t Lazy.t * t) T.literal list -> Get_type.t Lazy.t -> t
+      =
+   fun pos content _type_of ->
+    match content with
+    | [ T.Expression (t', _); T.Text "" ] -> (
+        match Get_type.get_type (Lazy.force t') with
+        | Get_type.Integer -> []
+        | _ ->
+            let msg = Report.debug pos "This expression can be simplified" in
+            [ msg ])
+    | _ -> []
+
+  let ident :
+      (S.pos, Get_type.t Lazy.t * t) S.variable -> Get_type.t Lazy.t -> t =
+   fun variable _type_of ->
+    match variable.index with None -> [] | Some (_, t) -> t
+
+  let integer : S.pos -> string -> Get_type.t Lazy.t -> t =
+   fun pos t _type_of ->
+    ignore pos;
+    ignore t;
+    []
+
+  let function_ :
+      S.pos ->
+      T.function_ ->
+      (Get_type.t Lazy.t * t) list ->
+      Get_type.t Lazy.t ->
+      t =
+   fun pos f expressions _type_of ->
+    ignore pos;
+    ignore f;
+    let exprs =
+      List.fold_left ~init:[] expressions ~f:(fun acc el ->
+          List.rev_append (snd el) acc)
+    in
+    exprs
+
+  let uoperator :
+      S.pos -> T.uoperator -> Get_type.t Lazy.t * t -> Get_type.t Lazy.t -> t =
+   fun pos op r _type_of ->
+    ignore op;
+    ignore pos;
+    snd r
+
+  let boperator :
+      S.pos ->
+      T.boperator ->
+      Get_type.t Lazy.t * t ->
+      Get_type.t Lazy.t * t ->
+      Get_type.t Lazy.t ->
+      t =
+   fun pos op (_, r1) (_, r2) _type_of ->
+    ignore pos;
+    ignore op;
+    r1 @ r2
+end)
+
+module Instruction :
+  S.Instruction with type t' = Report.t list and type expression = Expression.t' =
+struct
+  type t = Report.t list
+  (** Internal type used in the evaluation *)
+
+  type t' = t
+
+  let v : t -> t' = Fun.id
+
+  type expression = Expression.t'
+
+  let call : S.pos -> T.keywords -> expression list -> t =
+   fun pos k exprs ->
+    ignore pos;
+    ignore k;
+    List.concat exprs
+
+  let location : S.pos -> string -> t = fun _ _ -> []
+  let comment : S.pos -> t = fun _ -> []
+  let expression : expression -> t = Fun.id
+
+  let act : S.pos -> label:expression -> t list -> t =
+   fun pos ~label instructions ->
+    ignore pos;
+    List.concat (label :: instructions)
+
+  let fold_clause : (expression, t) S.clause -> t =
+   fun (_pos1, expression, ts) -> List.concat (expression :: ts)
+
+  let if_ :
+      S.pos ->
+      (expression, t) S.clause ->
+      elifs:(expression, t) S.clause list ->
+      else_:(S.pos * t list) option ->
+      t =
+   fun pos clause ~elifs ~else_ ->
+    ignore pos;
+
+    let init =
+      match else_ with
+      | None -> fold_clause clause
+      | Some (_, ts) -> List.rev_append (fold_clause clause) (List.concat ts)
+    in
+
+    List.fold_left elifs ~init ~f:(fun t clause ->
+        List.rev_append (fold_clause clause) t)
+
+  let assign :
+      S.pos ->
+      (S.pos, expression) S.variable ->
+      T.assignation_operator ->
+      expression ->
+      t =
+   fun pos variable op expression ->
+    ignore pos;
+    ignore op;
+    match variable.index with
+    | None -> expression
+    | Some v -> List.rev_append v expression
+end
+
+module Location = struct
+  type t = Report.t list
+  type instruction = Instruction.t'
+
+  let v = Fun.id
+
+  let location : unit -> S.pos -> instruction list -> t =
+   fun () pos intructions ->
+    ignore pos;
+    List.concat intructions
+end
-- 
cgit v1.2.3