diff options
Diffstat (limited to 'lib/syntax/write_only.ml')
| -rw-r--r-- | lib/syntax/write_only.ml | 217 |
1 files changed, 0 insertions, 217 deletions
diff --git a/lib/syntax/write_only.ml b/lib/syntax/write_only.ml deleted file mode 100644 index ec2e368..0000000 --- a/lib/syntax/write_only.ml +++ /dev/null @@ -1,217 +0,0 @@ -(** Check all the write_only variables *) - -open StdLabels - -(** 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 - -module Key = struct - type t = string - - let equal = String.equal - let hash = Hashtbl.hash - let compare = String.compare -end - -module StringMap = Hashtbl.Make (Key) -module Set = Set.Make (Key) - -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 : (S.pos, t) S.variable -> t = - fun variable filename map -> - (* Update the map and set the read flag *) - set_readed variable.pos variable.name filename map - - let literal : S.pos -> t T.literal list -> t = - fun pos l filename map -> - 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_ : S.pos -> T.function_ -> t list -> t = - fun _ _ exprs filename map -> List.iter ~f:(fun v -> v filename map) exprs - - let uoperator : S.pos -> T.uoperator -> t -> t = fun _ _ t map -> t map - - let boperator : S.pos -> T.boperator -> t -> t -> t = - fun _ _ t1 t2 filename map -> - 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 |