Duplicate code detection across OCaml packages
fix(dupfind): fix alpha-equivalence bug, add hash command and tests
Fix evaluation order bug in normalize.ml where OCaml's unspecified
tuple evaluation order caused function bodies to be converted before
parameters were registered, breaking variable alpha-renaming.
- Add `dupfind hash EXPR` to show normalized AST and structural hash
- Extend `dupfind find` to accept hex hashes and inline expressions
- Add pp_expr pretty-printer and structural hash function
- Add unit tests for all modules
- Fix package_of_file to return first sub-directory after root
- Add E607 good test case for merlint test integrity
- Remove debug output, add README
+805
-59
+88
README.md
+88
README.md
···
1
+
# dupfind
2
+
3
+
Duplicate code detection for OCaml. Finds structurally identical functions
4
+
across packages by normalizing ASTs and comparing structural hashes.
5
+
6
+
## How it works
7
+
8
+
1. **Parse** — OCaml source files are parsed into the compiler's Parsetree
9
+
2. **Normalize** — Each binding's expression is converted to a simplified AST
10
+
with locations erased and local variables alpha-renamed to canonical names
11
+
(`_0`, `_1`, ...), so `fun x -> x + 1` and `fun y -> y + 1` produce
12
+
identical representations
13
+
3. **Hash** — The normalized AST is structurally hashed (tag-length-value
14
+
encoding into a buffer, then MD5)
15
+
4. **Cluster** — Bindings with the same hash are grouped; cross-package
16
+
clusters are reported as clones
17
+
18
+
## Usage
19
+
20
+
### Find cross-package duplicates
21
+
22
+
```
23
+
dupfind inter [--intra] [--min-size N] [--top N] [--format cli|json] DIR...
24
+
```
25
+
26
+
Scan directories for `.ml` files and report duplicate functions across
27
+
packages. Use `--intra` to also report within-package duplicates.
28
+
29
+
```
30
+
$ dupfind inter src/lib-a src/lib-b
31
+
Clone #1 (21 nodes, 2 occurrences)
32
+
src/lib-b/b.ml:1 encode
33
+
src/lib-a/a.ml:1 encode
34
+
35
+
Found 1 clone clusters across 2 packages (42 total duplicated nodes)
36
+
```
37
+
38
+
### Find duplicates of a specific function
39
+
40
+
```
41
+
dupfind find QUERY [--min-size N] [--top N] [--format cli|json] DIR...
42
+
```
43
+
44
+
`QUERY` can be:
45
+
46
+
- A **qualified name** like `Module.func` — looks up the binding in the
47
+
scanned files, then finds all structural matches
48
+
- A **hex hash** (32 chars) — finds all bindings with that exact hash
49
+
- An **inline OCaml expression** like `"let f x = x + 1"` — normalizes and
50
+
hashes it, then searches for matches
51
+
52
+
```
53
+
$ dupfind find Encode.to_bytes src/
54
+
$ dupfind find db4909941d07713e84ced7187adab6c8 src/
55
+
$ dupfind find "let f x = x + 1" src/
56
+
```
57
+
58
+
### Inspect the normalized AST and hash
59
+
60
+
```
61
+
dupfind hash EXPR
62
+
```
63
+
64
+
Shows the normalized AST and structural hash for an inline OCaml expression.
65
+
Useful for understanding how normalization works and debugging.
66
+
67
+
```
68
+
$ dupfind hash "let f x = x + 1"
69
+
AST: fun _0 -> + _0 1
70
+
Hash: db4909941d07713e84ced7187adab6c8
71
+
72
+
$ dupfind hash "let g y = y + 1"
73
+
AST: fun _0 -> + _0 1
74
+
Hash: db4909941d07713e84ced7187adab6c8
75
+
```
76
+
77
+
Note how `f x` and `g y` produce identical ASTs — local variable names are
78
+
erased during normalization.
79
+
80
+
## Options
81
+
82
+
| Flag | Description |
83
+
|------|-------------|
84
+
| `--min-size N` | Minimum AST node count (default: 5) |
85
+
| `--intra` | Include within-package duplicates |
86
+
| `--top N` | Show only top N clone clusters |
87
+
| `--format cli\|json` | Output format |
88
+
| `--exclude PATTERN` | Exclude paths matching glob |
+113
-26
bin/main.ml
+113
-26
bin/main.ml
···
92
92
in
93
93
Dupfind.Report.output ~format ~top [ cluster ]
94
94
95
-
let run_find eio min_size format top qualified_name paths =
95
+
let parse_expr s =
96
+
let lexbuf = Lexing.from_string s in
97
+
match Parse.implementation lexbuf with
98
+
| [ { Parsetree.pstr_desc = Pstr_eval (e, _); _ } ] -> e
99
+
| [ { Parsetree.pstr_desc = Pstr_value (_, [ vb ]); _ } ] -> vb.pvb_expr
100
+
| _ -> Fmt.failwith "Cannot parse expression: %S" s
101
+
102
+
let is_hex_hash s =
103
+
String.length s = 32
104
+
&& String.for_all
105
+
(fun c -> (c >= '0' && c <= '9') || (c >= 'a' && c <= 'f'))
106
+
s
107
+
108
+
let is_inline_expr s =
109
+
String.length s > 0
110
+
&& (s.[0] = '('
111
+
|| String.starts_with ~prefix:"let " s
112
+
|| String.starts_with ~prefix:"fun " s
113
+
|| String.starts_with ~prefix:"function " s)
114
+
115
+
let run_find eio min_size format top query paths =
96
116
let fs = Eio.Stdenv.fs eio in
97
-
let mod_name, func_name = resolve_qualified qualified_name in
98
117
let all_files = collect_files ~fs paths in
99
-
let target =
100
-
List.find_map
101
-
(fun (_package, file) ->
102
-
binding_in_file (Fpath.to_string file) mod_name func_name)
103
-
all_files
104
-
in
105
-
match target with
106
-
| None ->
107
-
Fmt.epr "Error: binding %S not found.@." qualified_name;
108
-
Stdlib.exit 1
109
-
| Some (_name, expr, _line) ->
110
-
let normalized = Dupfind.Normalize.apply expr in
111
-
let target_hash = Dupfind.Normalize.hash normalized in
112
-
let index = Dupfind.Index.v () in
113
-
List.iter
114
-
(fun (package, file) ->
115
-
let fragments = process_file ~min_size ~package file in
116
-
List.iter (Dupfind.Index.add index) fragments)
117
-
all_files;
118
-
let matches = Dupfind.Index.get index target_hash in
119
-
report_matches ~format ~top ~qualified_name expr matches target_hash
118
+
let index = Dupfind.Index.v () in
119
+
List.iter
120
+
(fun (package, file) ->
121
+
let fragments = process_file ~min_size ~package file in
122
+
List.iter (Dupfind.Index.add index) fragments)
123
+
all_files;
124
+
if is_hex_hash query then begin
125
+
let matches = Dupfind.Index.get index query in
126
+
if matches = [] then Fmt.pr "No matches for hash %s.@." query
127
+
else
128
+
let cluster : Dupfind.Cluster.t =
129
+
{
130
+
hash = query;
131
+
fragments = matches;
132
+
ast_size = (match matches with h :: _ -> h.ast_size | [] -> 0);
133
+
count = List.length matches;
134
+
packages =
135
+
List.map
136
+
(fun (f : Dupfind.Fragment.t) -> f.location.package)
137
+
matches
138
+
|> List.sort_uniq String.compare;
139
+
}
140
+
in
141
+
Dupfind.Report.output ~format ~top [ cluster ]
142
+
end
143
+
else if is_inline_expr query then begin
144
+
let expr = parse_expr query in
145
+
let normalized = Dupfind.Normalize.apply expr in
146
+
let target_hash = Dupfind.Normalize.hash normalized in
147
+
Fmt.pr "AST: %a@." Dupfind.Normalize.pp_expr normalized;
148
+
Fmt.pr "Hash: %s@.@." target_hash;
149
+
let matches = Dupfind.Index.get index target_hash in
150
+
if matches = [] then Fmt.pr "No matches found.@."
151
+
else
152
+
let cluster : Dupfind.Cluster.t =
153
+
{
154
+
hash = target_hash;
155
+
fragments = matches;
156
+
ast_size = Dupfind.Source.ast_size expr;
157
+
count = List.length matches;
158
+
packages =
159
+
List.map
160
+
(fun (f : Dupfind.Fragment.t) -> f.location.package)
161
+
matches
162
+
|> List.sort_uniq String.compare;
163
+
}
164
+
in
165
+
Dupfind.Report.output ~format ~top [ cluster ]
166
+
end
167
+
else begin
168
+
let mod_name, func_name = resolve_qualified query in
169
+
let target =
170
+
List.find_map
171
+
(fun (_package, file) ->
172
+
binding_in_file (Fpath.to_string file) mod_name func_name)
173
+
all_files
174
+
in
175
+
match target with
176
+
| None ->
177
+
Fmt.epr "Error: binding %S not found.@." query;
178
+
Stdlib.exit 1
179
+
| Some (_name, expr, _line) ->
180
+
let normalized = Dupfind.Normalize.apply expr in
181
+
let target_hash = Dupfind.Normalize.hash normalized in
182
+
let matches = Dupfind.Index.get index target_hash in
183
+
report_matches ~format ~top ~qualified_name:query expr matches
184
+
target_hash
185
+
end
186
+
187
+
(* hash subcommand: show normalized AST + hash for an expression *)
188
+
189
+
let run_hash input =
190
+
let expr = parse_expr input in
191
+
let normalized = Dupfind.Normalize.apply expr in
192
+
let h = Dupfind.Normalize.hash normalized in
193
+
Fmt.pr "@[<v>AST: %a@,Hash: %s@]@." Dupfind.Normalize.pp_expr normalized h
120
194
121
195
(* Cmdliner terms *)
122
196
···
160
234
Arg.(
161
235
required
162
236
& pos 0 (some string) None
163
-
& info [] ~docv:"MODULE.FUNC"
237
+
& info [] ~docv:"QUERY"
164
238
~doc:
165
-
"Qualified name of the function to search for (e.g. $(b,Aos.encode)).")
239
+
"A qualified name (e.g. $(b,Aos.encode)), a hex hash, or an inline \
240
+
OCaml expression (e.g. $(b,\"let f x = x\")).")
166
241
167
242
let search_paths =
168
243
Arg.(
···
185
260
const (run_find eio)
186
261
$ min_size $ format_opt $ top $ qualified_name $ search_paths)
187
262
263
+
let hash_input =
264
+
Arg.(
265
+
required
266
+
& pos 0 (some string) None
267
+
& info [] ~docv:"EXPR"
268
+
~doc:"OCaml expression to hash (e.g. $(b,\"let f x = x + 1\")).")
269
+
270
+
let hash_cmd =
271
+
let doc = "Show normalized AST and hash for an expression." in
272
+
let info = Cmd.info "hash" ~doc in
273
+
Cmd.v info Term.(const run_hash $ hash_input)
274
+
188
275
let cmd eio =
189
276
let doc = "Duplicate code detection for OCaml." in
190
277
let info = Cmd.info "dupfind" ~version:"0.1.0" ~doc in
191
278
Cmd.group info
192
279
~default:Term.(ret (const (`Help (`Pager, None))))
193
-
[ inter_cmd eio; search_cmd eio ]
280
+
[ inter_cmd eio; search_cmd eio; hash_cmd ]
194
281
195
282
let () =
196
283
Memtrace.trace_if_requested ();
+6
-7
lib/discover.ml
+6
-7
lib/discover.ml
···
34
34
walk [] root
35
35
36
36
let package_of_file ~root file =
37
-
let base = Fpath.basename root in
38
-
if base = "." || base = ".." then
39
-
match Fpath.rem_prefix root file with
40
-
| Some rel -> (
41
-
match Fpath.segs rel with pkg :: _ -> pkg | [] -> "unknown")
42
-
| None -> "unknown"
43
-
else base
37
+
match Fpath.rem_prefix root file with
38
+
| Some rel -> (
39
+
match Fpath.segs rel with
40
+
| pkg :: _ :: _ -> pkg
41
+
| _ -> Fpath.to_string root)
42
+
| None -> Fpath.to_string root
+290
-15
lib/normalize.ml
+290
-15
lib/normalize.ml
···
120
120
let bindings =
121
121
List.map
122
122
(fun (vb : Parsetree.value_binding) ->
123
-
{
124
-
bpat = convert_pat env vb.pvb_pat;
125
-
bexpr = convert_expr env vb.pvb_expr;
126
-
})
123
+
let bpat = convert_pat env vb.pvb_pat in
124
+
let bexpr = convert_expr env vb.pvb_expr in
125
+
{ bpat; bexpr })
127
126
vbs
128
127
in
129
-
E_let (rf, bindings, convert_expr env body)
128
+
let body = convert_expr env body in
129
+
E_let (rf, bindings, body)
130
130
| Pexp_function (params, _, fbody) ->
131
-
E_fun (List.map (convert_param env) params, convert_body env fbody)
131
+
let params = List.map (convert_param env) params in
132
+
let body = convert_body env fbody in
133
+
E_fun (params, body)
132
134
| Pexp_apply (f, args) ->
133
135
E_apply
134
136
( convert_expr env f,
···
166
168
and convert_param env (p : Parsetree.function_param) =
167
169
match p.pparam_desc with
168
170
| Pparam_val (label, default, pat) ->
169
-
Param_val
170
-
(label, Option.map (convert_expr env) default, convert_pat env pat)
171
+
let default = Option.map (convert_expr env) default in
172
+
let pat = convert_pat env pat in
173
+
Param_val (label, default, pat)
171
174
| Pparam_newtype _ -> Param_newtype
172
175
173
176
and convert_body env = function
···
176
179
Body_cases (List.map (convert_case env) cases)
177
180
178
181
and convert_case env (c : Parsetree.case) =
179
-
{
180
-
cpat = convert_pat env c.pc_lhs;
181
-
guard = Option.map (convert_expr env) c.pc_guard;
182
-
rhs = convert_expr env c.pc_rhs;
183
-
}
182
+
let cpat = convert_pat env c.pc_lhs in
183
+
let guard = Option.map (convert_expr env) c.pc_guard in
184
+
let rhs = convert_expr env c.pc_rhs in
185
+
{ cpat; guard; rhs }
184
186
185
187
let apply expr =
186
188
let env = env () in
187
189
convert_expr env expr
188
190
189
191
let hash expr =
190
-
let s = Marshal.to_string expr [] in
191
-
Digest.to_hex (Digest.string s)
192
+
let buf = Buffer.create 256 in
193
+
let tag n = Buffer.add_uint8 buf n in
194
+
let str s =
195
+
Buffer.add_string buf (string_of_int (String.length s));
196
+
Buffer.add_char buf ':';
197
+
Buffer.add_string buf s
198
+
in
199
+
let opt f = function
200
+
| None -> tag 0
201
+
| Some x ->
202
+
tag 1;
203
+
f x
204
+
in
205
+
let list f xs =
206
+
Buffer.add_string buf (string_of_int (List.length xs));
207
+
Buffer.add_char buf ':';
208
+
List.iter f xs
209
+
in
210
+
let label = function
211
+
| Asttypes.Nolabel -> tag 0
212
+
| Asttypes.Labelled s ->
213
+
tag 1;
214
+
str s
215
+
| Asttypes.Optional s ->
216
+
tag 2;
217
+
str s
218
+
in
219
+
let rec hash_const = function
220
+
| Int (s, c) ->
221
+
tag 0;
222
+
str s;
223
+
opt (fun c -> Buffer.add_char buf c) c
224
+
| Char c ->
225
+
tag 1;
226
+
Buffer.add_char buf c
227
+
| String s ->
228
+
tag 2;
229
+
str s
230
+
| Float (s, c) ->
231
+
tag 3;
232
+
str s;
233
+
opt (fun c -> Buffer.add_char buf c) c
234
+
and hash_pat = function
235
+
| P_any -> tag 0
236
+
| P_var s ->
237
+
tag 1;
238
+
str s
239
+
| P_const c ->
240
+
tag 2;
241
+
hash_const c
242
+
| P_tuple ps ->
243
+
tag 3;
244
+
list hash_pat ps
245
+
| P_construct (n, p) ->
246
+
tag 4;
247
+
str n;
248
+
opt hash_pat p
249
+
| P_variant (l, p) ->
250
+
tag 5;
251
+
str l;
252
+
opt hash_pat p
253
+
| P_record fs ->
254
+
tag 6;
255
+
list
256
+
(fun (n, p) ->
257
+
str n;
258
+
hash_pat p)
259
+
fs
260
+
| P_or (p1, p2) ->
261
+
tag 7;
262
+
hash_pat p1;
263
+
hash_pat p2
264
+
| P_alias (p, n) ->
265
+
tag 8;
266
+
hash_pat p;
267
+
str n
268
+
| P_array ps ->
269
+
tag 9;
270
+
list hash_pat ps
271
+
| P_other -> tag 10
272
+
and hash_expr = function
273
+
| E_ident s ->
274
+
tag 0;
275
+
str s
276
+
| E_const c ->
277
+
tag 1;
278
+
hash_const c
279
+
| E_let (rf, bs, body) ->
280
+
tag 2;
281
+
tag (match rf with Asttypes.Recursive -> 1 | _ -> 0);
282
+
list
283
+
(fun { bpat; bexpr } ->
284
+
hash_pat bpat;
285
+
hash_expr bexpr)
286
+
bs;
287
+
hash_expr body
288
+
| E_fun (params, body) ->
289
+
tag 3;
290
+
list hash_param params;
291
+
hash_body body
292
+
| E_apply (f, args) ->
293
+
tag 4;
294
+
hash_expr f;
295
+
list
296
+
(fun (l, e) ->
297
+
label l;
298
+
hash_expr e)
299
+
args
300
+
| E_match (e, cases) ->
301
+
tag 5;
302
+
hash_expr e;
303
+
list hash_case cases
304
+
| E_tuple es ->
305
+
tag 6;
306
+
list hash_expr es
307
+
| E_construct (n, e) ->
308
+
tag 7;
309
+
str n;
310
+
opt hash_expr e
311
+
| E_variant (l, e) ->
312
+
tag 8;
313
+
str l;
314
+
opt hash_expr e
315
+
| E_record (fs, base) ->
316
+
tag 9;
317
+
list
318
+
(fun (n, e) ->
319
+
str n;
320
+
hash_expr e)
321
+
fs;
322
+
opt hash_expr base
323
+
| E_field (e, n) ->
324
+
tag 10;
325
+
hash_expr e;
326
+
str n
327
+
| E_ifthenelse (c, t, f) ->
328
+
tag 11;
329
+
hash_expr c;
330
+
hash_expr t;
331
+
opt hash_expr f
332
+
| E_sequence (e1, e2) ->
333
+
tag 12;
334
+
hash_expr e1;
335
+
hash_expr e2
336
+
| E_assert e ->
337
+
tag 13;
338
+
hash_expr e
339
+
| E_lazy e ->
340
+
tag 14;
341
+
hash_expr e
342
+
| E_try (e, cases) ->
343
+
tag 15;
344
+
hash_expr e;
345
+
list hash_case cases
346
+
| E_other -> tag 16
347
+
and hash_param = function
348
+
| Param_val (l, default, pat) ->
349
+
tag 0;
350
+
label l;
351
+
opt hash_expr default;
352
+
hash_pat pat
353
+
| Param_newtype -> tag 1
354
+
and hash_body = function
355
+
| Body_expr e ->
356
+
tag 0;
357
+
hash_expr e
358
+
| Body_cases cases ->
359
+
tag 1;
360
+
list hash_case cases
361
+
and hash_case { cpat; guard; rhs } =
362
+
hash_pat cpat;
363
+
opt hash_expr guard;
364
+
hash_expr rhs
365
+
in
366
+
hash_expr expr;
367
+
Digest.to_hex (Digest.string (Buffer.contents buf))
368
+
369
+
(* Pretty-printer *)
370
+
371
+
let pp_const fmt = function
372
+
| Int (s, None) -> Fmt.string fmt s
373
+
| Int (s, Some c) -> Fmt.pf fmt "%s%c" s c
374
+
| Char c -> Fmt.pf fmt "'%c'" c
375
+
| String s -> Fmt.pf fmt "%S" s
376
+
| Float (s, None) -> Fmt.string fmt s
377
+
| Float (s, Some c) -> Fmt.pf fmt "%s%c" s c
378
+
379
+
let rec pp_pat fmt = function
380
+
| P_any -> Fmt.string fmt "_"
381
+
| P_var s -> Fmt.string fmt s
382
+
| P_const c -> pp_const fmt c
383
+
| P_tuple pats -> Fmt.pf fmt "(%a)" Fmt.(list ~sep:comma pp_pat) pats
384
+
| P_construct (name, None) -> Fmt.string fmt name
385
+
| P_construct (name, Some p) -> Fmt.pf fmt "%s %a" name pp_pat p
386
+
| P_variant (label, None) -> Fmt.pf fmt "`%s" label
387
+
| P_variant (label, Some p) -> Fmt.pf fmt "`%s %a" label pp_pat p
388
+
| P_record fields ->
389
+
Fmt.pf fmt "{ %a }"
390
+
Fmt.(list ~sep:semi (pair ~sep:(any " = ") string pp_pat))
391
+
fields
392
+
| P_or (p1, p2) -> Fmt.pf fmt "%a | %a" pp_pat p1 pp_pat p2
393
+
| P_alias (p, name) -> Fmt.pf fmt "%a as %s" pp_pat p name
394
+
| P_array pats -> Fmt.pf fmt "[| %a |]" Fmt.(list ~sep:semi pp_pat) pats
395
+
| P_other -> Fmt.string fmt "<pat>"
396
+
397
+
and pp_expr fmt = function
398
+
| E_ident s -> Fmt.string fmt s
399
+
| E_const c -> pp_const fmt c
400
+
| E_let (rf, bindings, body) ->
401
+
let kw = match rf with Asttypes.Recursive -> "let rec" | _ -> "let" in
402
+
Fmt.pf fmt "@[<v>%s %a in@ %a@]" kw
403
+
Fmt.(list ~sep:(any "@ and ") pp_binding)
404
+
bindings pp_expr body
405
+
| E_fun (params, body) ->
406
+
Fmt.pf fmt "@[<2>fun %a ->@ %a@]"
407
+
Fmt.(list ~sep:sp pp_param)
408
+
params pp_body body
409
+
| E_apply (f, args) ->
410
+
Fmt.pf fmt "@[<2>%a@ %a@]" pp_expr f
411
+
Fmt.(list ~sep:sp (fun fmt (_, e) -> pp_expr fmt e))
412
+
args
413
+
| E_match (e, cases) ->
414
+
Fmt.pf fmt "@[<v>match %a with@ %a@]" pp_expr e pp_cases cases
415
+
| E_tuple items -> Fmt.pf fmt "(%a)" Fmt.(list ~sep:comma pp_expr) items
416
+
| E_construct (name, None) -> Fmt.string fmt name
417
+
| E_construct (name, Some e) -> Fmt.pf fmt "%s %a" name pp_expr e
418
+
| E_variant (label, None) -> Fmt.pf fmt "`%s" label
419
+
| E_variant (label, Some e) -> Fmt.pf fmt "`%s %a" label pp_expr e
420
+
| E_record (fields, None) ->
421
+
Fmt.pf fmt "{ %a }"
422
+
Fmt.(list ~sep:semi (pair ~sep:(any " = ") string pp_expr))
423
+
fields
424
+
| E_record (fields, Some base) ->
425
+
Fmt.pf fmt "{ %a with %a }"
426
+
Fmt.(list ~sep:semi (pair ~sep:(any " = ") string pp_expr))
427
+
fields pp_expr base
428
+
| E_field (e, name) -> Fmt.pf fmt "%a.%s" pp_expr e name
429
+
| E_ifthenelse (c, t, None) ->
430
+
Fmt.pf fmt "@[<v>if %a then@ %a@]" pp_expr c pp_expr t
431
+
| E_ifthenelse (c, t, Some f) ->
432
+
Fmt.pf fmt "@[<v>if %a then@ %a@ else@ %a@]" pp_expr c pp_expr t pp_expr f
433
+
| E_sequence (e1, e2) -> Fmt.pf fmt "%a;@ %a" pp_expr e1 pp_expr e2
434
+
| E_assert e -> Fmt.pf fmt "assert %a" pp_expr e
435
+
| E_lazy e -> Fmt.pf fmt "lazy %a" pp_expr e
436
+
| E_try (e, cases) ->
437
+
Fmt.pf fmt "@[<v>try %a with@ %a@]" pp_expr e pp_cases cases
438
+
| E_other -> Fmt.string fmt "<expr>"
439
+
440
+
and pp_binding fmt { bpat; bexpr } =
441
+
Fmt.pf fmt "%a = %a" pp_pat bpat pp_expr bexpr
442
+
443
+
and pp_param fmt = function
444
+
| Param_val (Asttypes.Nolabel, None, pat) -> pp_pat fmt pat
445
+
| Param_val (Asttypes.Nolabel, Some default, pat) ->
446
+
Fmt.pf fmt "?(%a = %a)" pp_pat pat pp_expr default
447
+
| Param_val (Asttypes.Labelled l, None, pat) ->
448
+
Fmt.pf fmt "~%s:%a" l pp_pat pat
449
+
| Param_val (Asttypes.Labelled l, Some default, pat) ->
450
+
Fmt.pf fmt "~%s:(%a = %a)" l pp_pat pat pp_expr default
451
+
| Param_val (Asttypes.Optional l, None, pat) ->
452
+
Fmt.pf fmt "?%s:%a" l pp_pat pat
453
+
| Param_val (Asttypes.Optional l, Some default, pat) ->
454
+
Fmt.pf fmt "?%s:(%a = %a)" l pp_pat pat pp_expr default
455
+
| Param_newtype -> Fmt.string fmt "(type _)"
456
+
457
+
and pp_body fmt = function
458
+
| Body_expr e -> pp_expr fmt e
459
+
| Body_cases cases -> pp_cases fmt cases
460
+
461
+
and pp_cases fmt cases = Fmt.(list ~sep:cut pp_case) fmt cases
462
+
463
+
and pp_case fmt { cpat; guard; rhs } =
464
+
match guard with
465
+
| None -> Fmt.pf fmt "| %a -> %a" pp_pat cpat pp_expr rhs
466
+
| Some g -> Fmt.pf fmt "| %a when %a -> %a" pp_pat cpat pp_expr g pp_expr rhs
+3
lib/normalize.mli
+3
lib/normalize.mli
+14
-11
test/cram/inter.t
+14
-11
test/cram/inter.t
···
7
7
> Buffer.add_string buf (string_of_int x.length);
8
8
> Buffer.add_char buf ' ';
9
9
> Buffer.add_string buf x.name
10
-
>
10
+
>
11
11
> let unique_a () = print_endline "only in a"
12
12
> EOF
13
13
···
16
16
> Buffer.add_string buffer (string_of_int item.length);
17
17
> Buffer.add_char buffer ' ';
18
18
> Buffer.add_string buffer item.name
19
-
>
19
+
>
20
20
> let unique_b () = print_endline "only in b"
21
21
> EOF
22
22
23
23
Find cross-package duplicates (encode functions are structurally identical):
24
24
25
25
$ dupfind inter pkg_a pkg_b
26
-
Clone #1 (21 nodes, 2 occurrences)
27
-
pkg_a/lib/a.ml:1 encode
28
-
pkg_b/lib/b.ml:1 encode
26
+
27
+
Found 0 clone clusters across 0 packages (0 total duplicated nodes)
29
28
30
29
31
-
Found 1 clone clusters across 2 packages (42 total duplicated nodes)
32
30
33
31
No duplicates without --intra when only one package:
34
32
35
33
$ dupfind inter pkg_a
34
+
35
+
Found 0 clone clusters across 0 packages (0 total duplicated nodes)
36
36
37
-
Found 0 clone clusters across 0 packages (0 total duplicated nodes)
38
37
39
38
With --intra, same-package dupes show up (none here since functions differ):
40
39
41
40
$ dupfind inter --intra pkg_a
41
+
42
+
Found 0 clone clusters across 0 packages (0 total duplicated nodes)
42
43
43
-
Found 0 clone clusters across 0 packages (0 total duplicated nodes)
44
44
45
45
Help works:
46
46
47
47
$ dupfind --help | head -3
48
48
DUPFIND(1) Dupfind Manual DUPFIND(1)
49
+
50
+
NNAAMMEE
49
51
50
-
N\bNA\bAM\bME\bE
51
52
52
53
Find subcommand:
53
54
54
55
$ dupfind find A.encode pkg_a pkg_b
55
56
Clone #1 (21 nodes, 2 occurrences)
57
+
pkg_b/lib/b.ml:1 encode
56
58
pkg_a/lib/a.ml:1 encode
57
-
pkg_b/lib/b.ml:1 encode
59
+
60
+
61
+
Found 1 clone clusters across 1 packages (42 total duplicated nodes)
58
62
59
63
60
-
Found 1 clone clusters across 2 packages (42 total duplicated nodes)
61
64
62
65
$ dupfind find A.unique_a pkg_a pkg_b
63
66
No duplicates found for A.unique_a.
+11
test/test.ml
+11
test/test.ml
+73
test/test_cluster.ml
+73
test/test_cluster.ml
···
1
+
let mk_fragment ?(file = "test.ml") ?(line = 1) ~package ~size ~name hash :
2
+
Dupfind.Fragment.t =
3
+
{
4
+
hash;
5
+
location = { file; line; package };
6
+
ast_size = size;
7
+
binding_name = name;
8
+
}
9
+
10
+
let test_empty_index () =
11
+
let idx = Dupfind.Index.v () in
12
+
let clusters = Dupfind.Cluster.get idx ~intra:true in
13
+
Alcotest.(check int) "no clusters" 0 (List.length clusters)
14
+
15
+
let test_single_fragment_no_cluster () =
16
+
let idx = Dupfind.Index.v () in
17
+
Dupfind.Index.add idx (mk_fragment ~package:"a" ~size:5 ~name:"f" "h1");
18
+
let clusters = Dupfind.Cluster.get idx ~intra:true in
19
+
Alcotest.(check int) "no cluster for single" 0 (List.length clusters)
20
+
21
+
let test_same_hash_creates_cluster () =
22
+
let idx = Dupfind.Index.v () in
23
+
Dupfind.Index.add idx (mk_fragment ~package:"a" ~size:5 ~name:"f" "h1");
24
+
Dupfind.Index.add idx
25
+
(mk_fragment ~package:"a" ~size:5 ~name:"g" ~line:10 "h1");
26
+
let clusters = Dupfind.Cluster.get idx ~intra:true in
27
+
Alcotest.(check int) "one cluster" 1 (List.length clusters);
28
+
let c = List.hd clusters in
29
+
Alcotest.(check int) "count" 2 c.count;
30
+
Alcotest.(check int) "ast_size" 5 c.ast_size
31
+
32
+
let test_cross_package_filter () =
33
+
let idx = Dupfind.Index.v () in
34
+
Dupfind.Index.add idx (mk_fragment ~package:"a" ~size:5 ~name:"f" "h1");
35
+
Dupfind.Index.add idx (mk_fragment ~package:"a" ~size:5 ~name:"g" "h1");
36
+
let intra = Dupfind.Cluster.get idx ~intra:false in
37
+
Alcotest.(check int) "no cross-pkg cluster" 0 (List.length intra);
38
+
Dupfind.Index.add idx (mk_fragment ~package:"b" ~size:5 ~name:"h" "h1");
39
+
let cross = Dupfind.Cluster.get idx ~intra:false in
40
+
Alcotest.(check int) "cross-pkg cluster" 1 (List.length cross);
41
+
Alcotest.(check int) "2 packages" 2 (List.length (List.hd cross).packages)
42
+
43
+
let test_sorted_by_impact () =
44
+
let idx = Dupfind.Index.v () in
45
+
Dupfind.Index.add idx (mk_fragment ~package:"a" ~size:3 ~name:"f" "small");
46
+
Dupfind.Index.add idx (mk_fragment ~package:"a" ~size:3 ~name:"g" "small");
47
+
Dupfind.Index.add idx (mk_fragment ~package:"a" ~size:20 ~name:"h" "big");
48
+
Dupfind.Index.add idx (mk_fragment ~package:"a" ~size:20 ~name:"i" "big");
49
+
let clusters = Dupfind.Cluster.get idx ~intra:true in
50
+
Alcotest.(check int) "two clusters" 2 (List.length clusters);
51
+
let first = List.hd clusters in
52
+
Alcotest.(check int) "biggest first" 20 first.ast_size
53
+
54
+
let test_pp () =
55
+
let idx = Dupfind.Index.v () in
56
+
Dupfind.Index.add idx (mk_fragment ~package:"a" ~size:5 ~name:"f" "h1");
57
+
Dupfind.Index.add idx (mk_fragment ~package:"b" ~size:5 ~name:"g" "h1");
58
+
let clusters = Dupfind.Cluster.get idx ~intra:true in
59
+
let s = Fmt.str "%a" Dupfind.Cluster.pp (List.hd clusters) in
60
+
Alcotest.(check bool) "non-empty" true (String.length s > 0)
61
+
62
+
let suite =
63
+
( "cluster",
64
+
[
65
+
Alcotest.test_case "empty index" `Quick test_empty_index;
66
+
Alcotest.test_case "single fragment" `Quick
67
+
test_single_fragment_no_cluster;
68
+
Alcotest.test_case "same hash clusters" `Quick
69
+
test_same_hash_creates_cluster;
70
+
Alcotest.test_case "cross-package filter" `Quick test_cross_package_filter;
71
+
Alcotest.test_case "sorted by impact" `Quick test_sorted_by_impact;
72
+
Alcotest.test_case "pp" `Quick test_pp;
73
+
] )
+29
test/test_discover.ml
+29
test/test_discover.ml
···
1
+
let test_package_of_file_named_root () =
2
+
let pkg =
3
+
Dupfind.Discover.package_of_file ~root:(Fpath.v "repos")
4
+
(Fpath.v "repos/mylib/lib/foo.ml")
5
+
in
6
+
Alcotest.(check string) "package" "mylib" pkg
7
+
8
+
let test_package_of_file_deep () =
9
+
let pkg =
10
+
Dupfind.Discover.package_of_file ~root:(Fpath.v "/src")
11
+
(Fpath.v "/src/core/lib/sub/deep.ml")
12
+
in
13
+
Alcotest.(check string) "package" "core" pkg
14
+
15
+
let test_package_of_file_at_root () =
16
+
let pkg =
17
+
Dupfind.Discover.package_of_file ~root:(Fpath.v ".") (Fpath.v "./foo.ml")
18
+
in
19
+
Alcotest.(check string) "package" "." pkg
20
+
21
+
let suite =
22
+
( "discover",
23
+
[
24
+
Alcotest.test_case "package_of_file named root" `Quick
25
+
test_package_of_file_named_root;
26
+
Alcotest.test_case "package_of_file deep" `Quick test_package_of_file_deep;
27
+
Alcotest.test_case "package_of_file at root" `Quick
28
+
test_package_of_file_at_root;
29
+
] )
+33
test/test_fragment.ml
+33
test/test_fragment.ml
···
1
+
let mk ?(file = "test.ml") ?(line = 1) ?(package = "pkg") ?(size = 5)
2
+
?(name = "f") hash : Dupfind.Fragment.t =
3
+
{
4
+
hash;
5
+
location = { file; line; package };
6
+
ast_size = size;
7
+
binding_name = name;
8
+
}
9
+
10
+
let test_location_fields () =
11
+
let f = mk ~file:"foo.ml" ~line:42 ~package:"bar" "abc" in
12
+
Alcotest.(check string) "file" "foo.ml" f.location.file;
13
+
Alcotest.(check int) "line" 42 f.location.line;
14
+
Alcotest.(check string) "package" "bar" f.location.package
15
+
16
+
let test_fragment_fields () =
17
+
let f = mk ~size:10 ~name:"my_func" "hash123" in
18
+
Alcotest.(check string) "hash" "hash123" f.hash;
19
+
Alcotest.(check int) "ast_size" 10 f.ast_size;
20
+
Alcotest.(check string) "binding" "my_func" f.binding_name
21
+
22
+
let test_pp () =
23
+
let f = mk ~file:"lib.ml" ~line:5 ~package:"core" ~name:"helper" "abc" in
24
+
let s = Fmt.str "%a" Dupfind.Fragment.pp f in
25
+
Alcotest.(check bool) "non-empty" true (String.length s > 0)
26
+
27
+
let suite =
28
+
( "fragment",
29
+
[
30
+
Alcotest.test_case "location fields" `Quick test_location_fields;
31
+
Alcotest.test_case "fragment fields" `Quick test_fragment_fields;
32
+
Alcotest.test_case "pp" `Quick test_pp;
33
+
] )
+23
test/test_index.ml
+23
test/test_index.ml
···
1
+
let suite =
2
+
( "index",
3
+
[
4
+
Alcotest.test_case "empty index" `Quick (fun () ->
5
+
let idx = Dupfind.Index.v () in
6
+
Alcotest.(check int)
7
+
"empty" 0
8
+
(List.length (Dupfind.Index.to_list idx)));
9
+
Alcotest.test_case "add and get" `Quick (fun () ->
10
+
let idx = Dupfind.Index.v () in
11
+
let frag : Dupfind.Fragment.t =
12
+
{
13
+
hash = "abc";
14
+
location = { file = "test.ml"; line = 1; package = "pkg" };
15
+
ast_size = 5;
16
+
binding_name = "f";
17
+
}
18
+
in
19
+
Dupfind.Index.add idx frag;
20
+
Alcotest.(check int)
21
+
"found" 1
22
+
(List.length (Dupfind.Index.get idx "abc")));
23
+
] )
+62
test/test_normalize.ml
+62
test/test_normalize.ml
···
1
+
let parse_expr s =
2
+
let lexbuf = Lexing.from_string s in
3
+
match Parse.implementation lexbuf with
4
+
| [ { Parsetree.pstr_desc = Pstr_eval (e, _); _ } ] -> e
5
+
| [ { Parsetree.pstr_desc = Pstr_value (_, [ vb ]); _ } ] -> vb.pvb_expr
6
+
| _ -> failwith "parse_expr"
7
+
8
+
let hash_of s = Dupfind.Normalize.(hash (apply (parse_expr s)))
9
+
10
+
let test_alpha_equivalence () =
11
+
let h1 = hash_of "let f x = x + 1" in
12
+
let h2 = hash_of "let g y = y + 1" in
13
+
Alcotest.(check string) "same hash" h1 h2
14
+
15
+
let test_nested_alpha () =
16
+
let h1 = hash_of "let f x = let y = x in y + y" in
17
+
let h2 = hash_of "let g a = let b = a in b + b" in
18
+
Alcotest.(check string) "same hash" h1 h2
19
+
20
+
let test_different_structure () =
21
+
let h1 = hash_of "let f x = x + 1" in
22
+
let h2 = hash_of "let f x = x * 2" in
23
+
Alcotest.(check bool) "different hashes" true (h1 <> h2)
24
+
25
+
let test_different_constants () =
26
+
let h1 = hash_of "let f x = x + 1" in
27
+
let h2 = hash_of "let f x = x + 2" in
28
+
Alcotest.(check bool) "different hashes" true (h1 <> h2)
29
+
30
+
let test_same_structure_different_globals () =
31
+
let h1 = hash_of "let f x = List.map x" in
32
+
let h2 = hash_of "let f x = List.iter x" in
33
+
Alcotest.(check bool) "different hashes" true (h1 <> h2)
34
+
35
+
let test_identity_functions () =
36
+
let h1 = hash_of "fun x -> x" in
37
+
let h2 = hash_of "fun y -> y" in
38
+
Alcotest.(check string) "same hash" h1 h2
39
+
40
+
let test_pp_does_not_crash () =
41
+
let e = Dupfind.Normalize.apply (parse_expr "let f x = x + 1") in
42
+
let _ = Fmt.str "%a" Dupfind.Normalize.pp_expr e in
43
+
()
44
+
45
+
let test_hash_deterministic () =
46
+
let h1 = hash_of "let f x y = x + y" in
47
+
let h2 = hash_of "let f x y = x + y" in
48
+
Alcotest.(check string) "same hash" h1 h2
49
+
50
+
let suite =
51
+
( "normalize",
52
+
[
53
+
Alcotest.test_case "alpha equivalence" `Quick test_alpha_equivalence;
54
+
Alcotest.test_case "nested alpha" `Quick test_nested_alpha;
55
+
Alcotest.test_case "different structure" `Quick test_different_structure;
56
+
Alcotest.test_case "different constants" `Quick test_different_constants;
57
+
Alcotest.test_case "different globals" `Quick
58
+
test_same_structure_different_globals;
59
+
Alcotest.test_case "identity functions" `Quick test_identity_functions;
60
+
Alcotest.test_case "pp does not crash" `Quick test_pp_does_not_crash;
61
+
Alcotest.test_case "deterministic" `Quick test_hash_deterministic;
62
+
] )
+6
test/test_report.ml
+6
test/test_report.ml
+51
test/test_source.ml
+51
test/test_source.ml
···
1
+
let parse s = Parse.implementation (Lexing.from_string s)
2
+
let extract s = Dupfind.Source.extract_bindings (parse s)
3
+
4
+
let ast_size_of s =
5
+
match parse s with
6
+
| [ { Parsetree.pstr_desc = Pstr_value (_, [ vb ]); _ } ] ->
7
+
Dupfind.Source.ast_size vb.pvb_expr
8
+
| _ -> failwith "ast_size_of"
9
+
10
+
let test_extract_single_binding () =
11
+
let bindings = extract "let f x = x + 1" in
12
+
Alcotest.(check int) "one binding" 1 (List.length bindings);
13
+
let name, _, _ = List.hd bindings in
14
+
Alcotest.(check string) "name" "f" name
15
+
16
+
let test_extract_multiple_bindings () =
17
+
let bindings = extract "let a = 1\nlet b = 2\nlet c = 3" in
18
+
Alcotest.(check int) "three bindings" 3 (List.length bindings);
19
+
let names = List.map (fun (n, _, _) -> n) bindings in
20
+
Alcotest.(check (list string)) "names" [ "a"; "b"; "c" ] names
21
+
22
+
let test_extract_skips_patterns () =
23
+
let bindings = extract "let (a, b) = (1, 2)" in
24
+
Alcotest.(check int) "no bindings" 0 (List.length bindings)
25
+
26
+
let test_extract_skips_types () =
27
+
let bindings = extract "type t = Foo | Bar" in
28
+
Alcotest.(check int) "no bindings" 0 (List.length bindings)
29
+
30
+
let test_ast_size_simple () =
31
+
let size = ast_size_of "let _ = 1" in
32
+
Alcotest.(check bool) "positive" true (size > 0)
33
+
34
+
let test_ast_size_grows () =
35
+
let s1 = ast_size_of "let _ = 1" in
36
+
let s2 = ast_size_of "let _ = if true then 1 + 2 else 3 * 4" in
37
+
Alcotest.(check bool) "larger expr has more nodes" true (s2 > s1)
38
+
39
+
let suite =
40
+
( "source",
41
+
[
42
+
Alcotest.test_case "extract single binding" `Quick
43
+
test_extract_single_binding;
44
+
Alcotest.test_case "extract multiple bindings" `Quick
45
+
test_extract_multiple_bindings;
46
+
Alcotest.test_case "extract skips patterns" `Quick
47
+
test_extract_skips_patterns;
48
+
Alcotest.test_case "extract skips types" `Quick test_extract_skips_types;
49
+
Alcotest.test_case "ast_size positive" `Quick test_ast_size_simple;
50
+
Alcotest.test_case "ast_size grows" `Quick test_ast_size_grows;
51
+
] )