index : blog.git	master sailfish sailfish2
	Articles du blog	Sébastien Dailly

summaryrefslogtreecommitdiff

log msg author committer range

path: root/theme/templates/abstract.html

Age	Commit message (Collapse)	Author
2013-05-09	Updated theme	Sébastien Dailly
2013-05-08	Use uniform template for index category and tag page	Sébastien Dailly

generated by cgit v1.2.3 (git 2.46.0) at 2025-11-01 23:35:59 +0000

(** Check all the write_only variables *)

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

(** Identifier for the module *)
let identifier = "write_only"

(** Short description*)
let description = "Check variables never read"

(** Is the test active or not *)
let active = ref false

let is_global = true
let depends = []

type ex = Qsp_syntax.Identifier.t

module StringMap = Hashtbl.Make (String)
module Set = Set.Make (String)

type data = { write : bool; read : bool; position : S.pos list }
type context = (string * data) StringMap.t

let initialize () = StringMap.create 16

let keywords =
  [
    "BACKIMAGE";
    "$BACKIMAGE";
    "BCOLOR";
    "DEBUG";
    "DISABLESCROLL";
    "DISABLESUBEX";
    "FCOLOR";
    "$FNAME";
    "FSIZE";
    "GC";
    "LCOLOR";
    "NOSAVE";
  ]
  |> Set.of_list

let set_readed :
    ?update_only:bool -> S.pos -> string -> string -> context -> unit =
 fun ?(update_only = false) pos identifier filename map ->
  if not (Set.mem identifier keywords) then
    match (update_only, StringMap.find_opt map identifier) with
    | false, None ->
        StringMap.add map identifier
          (filename, { write = false; read = true; position = [] })
    | _, Some (filename, v) ->
        StringMap.replace map identifier
          (filename, { v with read = true; position = pos :: v.position })
    | true, None -> ()

let set_write : S.pos -> string -> string -> context -> unit =
 fun pos identifier filename map ->
  if not (Set.mem identifier keywords) then
    match StringMap.find_opt map identifier with
    | None ->
        StringMap.add map identifier
          (filename, { write = true; read = false; position = pos :: [] })
    | Some (filename, v) ->
        StringMap.replace map identifier
          (filename, { v with write = true; position = pos :: v.position })

module Expression = struct
  type t = string -> context -> unit

  let v : t -> t = Fun.id

  include Default.Expression (struct
    type nonrec t = t

    let default _ map = ignore map
  end)

  let ident : ctx:Qsp_syntax.S.extract_context -> (S.pos, t) S.variable -> t =
   fun ~ctx variable filename map ->
    ignore ctx;
    (* Update the map and set the read flag *)
    set_readed variable.pos variable.name filename map

  let literal :
      ctx:Qsp_syntax.S.extract_context -> S.pos -> t T.literal list -> t =
   fun ~ctx pos l filename map ->
    ignore ctx;
    List.iter l ~f:(function
      | T.Text t ->
          set_readed pos ~update_only:true (String.uppercase_ascii t) filename
            map
      | T.Expression exprs ->
          (* When the string contains an expression evaluate it *)
          exprs filename map)

  let function_ :
      ctx:Qsp_syntax.S.extract_context -> S.pos -> T.function_ -> t list -> t =
   fun ~ctx _ _ exprs filename map ->
    ignore ctx;
    List.iter ~f:(fun v -> v filename map) exprs

  let uoperator :
      ctx:Qsp_syntax.S.extract_context -> S.pos -> T.uoperator -> t -> t =
   fun ~ctx _ _ t map ->
    ignore ctx;
    t map

  let boperator :
      ctx:Qsp_syntax.S.extract_context -> S.pos -> T.boperator -> t -> t -> t =
   fun ~ctx _ _ t1 t2 filename map ->
    ignore ctx;
    t1 filename map;
    t2 filename map
end

module Instruction = struct
  type t = Expression.t
  (** Internal type used in the evaluation *)

  type t' = t

  let v : t -> t' = Fun.id

  type expression = Expression.t

  let location : S.pos -> string -> t = fun _pos _ _ _ -> ()

  let call : S.pos -> T.keywords -> expression list -> t =
   fun _ op exprs filename map ->
    match op with
    | T.KillVar ->
        (* Killing a variable does not count as reading it *)
        ()
    | _ -> List.iter ~f:(fun v -> v filename map) exprs

  let comment : S.pos -> t = fun _ _ _ -> ()
  let expression : expression -> t = fun expression map -> expression map

  let fold_clause : (expression, t) S.clause -> t =
   fun clause filename map ->
    let _, expr, exprs = clause in
    let () = expr filename map in
    let () = List.iter ~f:(fun v -> v filename map) exprs in
    ()

  let if_ :
      S.pos ->
      (expression, t) S.clause ->
      elifs:(expression, t) S.clause list ->
      else_:(S.pos * t list) option ->
      t =
   fun pos clauses ~elifs ~else_ filename map ->
    ignore pos;
    let () = fold_clause clauses filename map in
    let () = List.iter ~f:(fun v -> fold_clause v filename map) elifs in
    Option.iter
      (fun (_, exprs) -> List.iter exprs ~f:(fun v -> v filename map))
      else_;
    ()

  let act : S.pos -> label:expression -> t list -> t =
   fun pos ~label exprs filename map ->
    ignore pos;
    ignore label;
    List.iter ~f:(fun v -> v filename map) exprs

  let assign :
      S.pos ->
      (S.pos, expression) S.variable ->
      T.assignation_operator ->
      expression ->
      t =
   fun pos variable op expr filename map ->
    ignore op;
    ignore expr;
    Option.iter (fun v -> v filename map) variable.index;
    expr filename map;
    set_write pos variable.name filename map
end

module Location = struct
  type t = unit
  type instruction = string -> context -> unit

  let v : t -> Report.t list = fun _ -> []

  let location : context -> S.pos -> instruction list -> t =
   fun context pos instructions ->
    let file_name = (snd pos).Lexing.pos_fname in
    ignore pos;
    ignore context;
    let () = List.iter ~f:(fun v -> v file_name context) instructions in
    ()
end

(** Extract the results from the whole parsing *)
let finalize : context -> (string * Report.t) list =
 fun map ->
  let () =
    StringMap.filter_map_inplace
      (fun _ (loc, value) ->
        match value.read && value.write with
        | true -> None
        | false -> Some (loc, value))
      map
  in

  let report =
    StringMap.fold
      (fun ident (loc, value) report ->
        match value.read with
        | false ->
            List.fold_left value.position ~init:report ~f:(fun report pos ->
                let msg =
                  Report.debug pos
                    (String.concat ~sep:" "
                       [ "The variable"; ident; "is never read" ])
                in
                (loc, msg) :: report)
        | true -> report)
      map []
  in
  report