aboutsummaryrefslogtreecommitdiff
path: root/lib/csv/csv.ml
diff options
context:
space:
mode:
Diffstat (limited to 'lib/csv/csv.ml')
-rw-r--r--lib/csv/csv.ml30
1 files changed, 0 insertions, 30 deletions
diff --git a/lib/csv/csv.ml b/lib/csv/csv.ml
deleted file mode 100644
index db7329d..0000000
--- a/lib/csv/csv.ml
+++ /dev/null
@@ -1,30 +0,0 @@
-open StdLabels
-
-type t = int
-
-let column_of_char = function
- | 'A' .. 'Z' as c -> Char.code c - (Char.code 'A' - 1)
- | 'a' .. 'z' as c -> Char.code c - (Char.code 'a' - 1)
- | c -> raise (Invalid_argument ("column: " ^ Char.escaped c))
-
-let column_of_string : string -> int =
- fun s ->
- String.fold_left s ~init:0 ~f:(fun value c -> (value * 26) + column_of_char c)
-
-(** Accumulate the remaining for the successives divisions in a list. *)
-let rec _to_char ~b i =
- if i > 0 then
- let res = i mod 26 in
- let res = if res = 0 then 26 else res in
-
- let c = char_of_int @@ (res + 64) in
- (* The modulo is accumulated in the list head, which is the expected
- sequence *)
- let b = c :: b in
-
- _to_char ~b @@ ((i - res) / 26)
- else b
-
-let column_to_string i =
- let res = _to_char ~b:[] i in
- List.to_seq res |> String.of_seq
generated by cgit v1.2.3 (git 2.46.0) at 2025-11-01 23:24:52 +0000
146' href='#n146'>146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 
(** This module check for duplicated tests in the source.contents

    This in intended to identify the copy/paste errors, where one location check
    for the same arguments twice or more. *)

open StdLabels
module S = Qsp_syntax.S
module T = Qsp_syntax.T
module Report = Qsp_syntax.Report
module Tree = Qsp_syntax.Tree

let identifier = "duplicate_test"
let description = "Check for duplicate tests"
let is_global = false
let active = ref true
let depends = []

type ex = Qsp_syntax.Identifier.t
type context = unit

let initialize = Fun.id
let finalize () = []

module Expression = Tree.Expression

(** Build a Hashtbl over the expression, ignoring the location in the expression
*)
module Table = Hashtbl.Make (struct
  type t = Expression.t'

  let equal : t -> t -> bool = Tree.Expression.eq (fun _ _ -> true)
  let hash : t -> int = Tree.Expression.hash (fun _ -> 0)
end)

module Instruction = struct
  type state = {
    predicates : (Expression.t' * S.pos) list;
    duplicates : (Expression.t' * S.pos list) list;
  }
  (** Keep the list of all the predicates and their position in a block, and the
      list of all the identified duplicated values. *)

  type t = state
  type t' = state

  let default = { predicates = []; duplicates = [] }

  include
    Default.Instruction
      (Expression)
      (struct
        type nonrec t = t

        let default = default

        let fold sequence =
          Seq.fold_left
            (fun state ex ->
              {
                predicates = [];
                duplicates = List.rev_append ex.duplicates state.duplicates;
              })
            default sequence
      end)

  let v : t -> t' = fun t -> t

  let check_duplicates :
      (Expression.t' * S.pos) list -> (Expression.t' * S.pos list) list =
   fun predicates ->
    let table = Table.create 5 in
    let () = List.to_seq predicates |> Table.add_seq table in

    Table.to_seq_keys table
    |> Seq.group (Tree.Expression.eq (fun _ _ -> true))
    |> Seq.filter_map (fun keys ->
           (* Only take the first element for each group, we don’t need to
              repeat the key *)
           match Seq.uncons keys with
           | None -> None
           | Some (hd, _) -> (
               match Table.find_all table hd with
               | [] | _ :: [] -> None
               | other -> Some (hd, other)))
    |> List.of_seq

  (** Evaluate a clause. This function does two things :
      - report all errors from the bottom to top
      - add the clause in the actual level *)
  let predicate_of_clause : ?pos:S.pos -> t -> (Expression.t', t) S.clause -> t
      =
   fun ?pos t (pos2, predicate, blocks) ->
    let pos = Option.value ~default:pos2 pos in

    (* Remove the clauses using the function rnd because they repeating the
       same clause can generate a different result *)
    let should_discard =
      Tree.Expression.exists predicate ~f:(function
        | Tree.Ast.Function (_, T.Rand, _) | Tree.Ast.Function (_, T.Rnd, _) ->
            true
        | _ -> false)
    in

    {
      predicates =
        (match should_discard with
        | false -> (predicate, pos) :: t.predicates
        | true -> t.predicates);
      duplicates =
        List.fold_left blocks ~init:t.duplicates ~f:(fun acc t ->
            List.rev_append t.duplicates acc);
    }

  let if_ :
      S.pos ->
      (Expression.t', t) S.clause ->
      elifs:(Expression.t', t) S.clause list ->
      else_:(S.pos * t list) option ->
      t =
   fun pos clause ~elifs ~else_ ->
    ignore else_;
    (* Collect all the if clauses from this block, wait for the parent block to
       check each case for duplicates. *)
    let init = predicate_of_clause ~pos default clause in
    let state = List.fold_left elifs ~init ~f:predicate_of_clause in
    {
      state with
      duplicates = check_duplicates state.predicates @ state.duplicates;
    }
end

module Location = struct
  type t = (Expression.t' * S.pos list) list

  type context = unit
  (** No context *)

  (** Check if the given expression is involving the variable ARGS or $ARGS *)
  let is_args : Expression.t' -> bool = function
    | Tree.Ast.Ident { name; _ } ->
        String.equal name "ARGS" || String.equal name "$ARGS"
    | _ -> false

  let location : context -> S.pos -> Instruction.t' list -> t =
   fun () _ block ->
    (* Filter the tests from the top level and only keep them testing ARGS *)
    let duplicates =
      List.map block ~f:(fun t ->
          List.filter_map t.Instruction.predicates ~f:(fun v ->
              match (Tree.Expression.exists ~f:is_args) (fst v) with
              | true -> Some v
              | false -> None))
      |> List.concat |> Instruction.check_duplicates
    in
    List.fold_left ~init:duplicates block ~f:(fun state ex ->
        List.rev_append ex.Instruction.duplicates state)

  (** Create the report message *)
  let v' : Expression.t' * S.pos list -> Report.t option =
   fun (expr, pos) ->
    ignore expr;
    match (List.sort ~cmp:Report.compare_pos) pos with
    | [] -> None
    | _ :: [] -> None
    | hd :: tl ->
        let message =
          Format.asprintf "This case is duplicated line(s) %a"
            (Format.pp_print_list
               ~pp_sep:(fun f () -> Format.pp_print_char f ',')
               Report.pp_line)
            tl
        in

        (* Report all the messages as error. They do not break the game, but
           there is no question if it should *)
        Some (Report.warn hd message)

  let v : t -> Report.t list =
   fun t -> List.filter_map t ~f:v' |> List.sort_uniq ~cmp:Report.compare
end