1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
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
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
|
(** 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 = (fst 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
|
