From fd02a44392304986a756e7d06f8142538b386529 Mon Sep 17 00:00:00 2001 From: Chimrod <> Date: Thu, 2 Nov 2023 17:35:49 +0100 Subject: Added a new checkers for unecessary use of strig containing an escaped expression --- lib/syntax/nested_strings.ml | 109 ++++++++++++++++++++++++++++++++++++++++++ lib/syntax/nested_strings.mli | 1 + 2 files changed, 110 insertions(+) create mode 100644 lib/syntax/nested_strings.ml create mode 100644 lib/syntax/nested_strings.mli (limited to 'lib/syntax') diff --git a/lib/syntax/nested_strings.ml b/lib/syntax/nested_strings.ml new file mode 100644 index 0000000..fb056d6 --- /dev/null +++ b/lib/syntax/nested_strings.ml @@ -0,0 +1,109 @@ +open StdLabels + +module Expression : S.Expression with type t' = Report.t list = struct + type t = Report.t list + type t' = t + + let v : t -> t' = Fun.id + + (** 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 -> t T.literal list -> t = + fun pos content -> + match content with + | [ T.Expression expr; T.Text "" ] -> + ignore expr; + let msg = Report.debug pos "This expression can be simplified" in + [ msg ] + | _ -> [] + + let ident : (S.pos, t) S.variable -> t = + fun { pos; name : string; index : t option } -> + ignore pos; + ignore name; + match index with None -> [] | Some v -> v + + let integer : S.pos -> string -> t = fun _ _ -> [] + + let function_ : S.pos -> T.function_ -> t list -> t = + fun _ _ expressions -> List.concat expressions + + let uoperator : S.pos -> T.uoperator -> t -> t = fun _ _ expr1 -> expr1 + + let boperator : S.pos -> T.boperator -> t -> t -> t = + fun _ _ expr1 expr2 -> expr1 @ expr2 +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 = unit + type instruction = Instruction.t' + + let location : S.pos -> instruction list -> t * Report.t list = + fun pos intructions -> + ignore pos; + ((), List.concat intructions) +end diff --git a/lib/syntax/nested_strings.mli b/lib/syntax/nested_strings.mli new file mode 100644 index 0000000..38e3a1b --- /dev/null +++ b/lib/syntax/nested_strings.mli @@ -0,0 +1 @@ +include S.Analyzer -- cgit v1.2.3