anil.recoil.org
The unpac monorepo manager self-hosting as a monorepo using unpac
refactor: print consecutive char sequences better (#548)
authored by
Rudi Grinberg
and committed by
GitHub
e8e8ecb0
f87f7adb
+49
-10
lib/automata.ml
+49
-10
lib/automata.ml
···
85
| `First -> "first"
86
;;
87
88
-
let to_dyn t : Dyn.t = Enum (to_string t)
89
let equal = Poly.equal
90
let pp ch k = Format.pp_print_string ch (to_string k)
91
end
···
175
| After of Category.t
176
| Pmark of Pmark.t
177
178
-
let rec dyn_of_def =
179
let open Dyn in
180
function
181
| Cst cset -> Cset.to_dyn cset
182
-
| Alt alt -> variant "Alt" (List.map ~f:to_dyn alt)
183
-
| Seq (sem, x, y) -> variant "Seq" [ Sem.to_dyn sem; to_dyn x; to_dyn y ]
184
| Eps -> Enum "Eps"
185
-
| Rep (_, sem, t) -> variant "Rep" [ Sem.to_dyn sem; to_dyn t ]
186
| Mark m -> variant "Mark" [ Mark.to_dyn m ]
187
| Pmark m -> variant "Pmark" [ Pmark.to_dyn m ]
188
| Erase (x, y) -> variant "Erase" [ Mark.to_dyn x; Mark.to_dyn y ]
189
| Before c -> variant "Before" [ Category.to_dyn c ]
190
| After c -> variant "After" [ Category.to_dyn c ]
191
192
-
and to_dyn { id = _; def } = dyn_of_def def
193
194
let with_sem prev next fmt pp () =
195
let open Fmt in
···
414
415
type t = E.t list
416
417
-
let rec to_dyn t = Dyn.list (List.map ~f:dyn_of_e t)
418
419
-
and dyn_of_e =
420
let open Dyn in
421
function
422
-
| E.TSeq (sem, x, y) -> variant "TSeq" [ Sem.to_dyn sem; to_dyn x; Expr.to_dyn y ]
423
| TExp (marks, e) ->
424
let e =
425
-
let base = [ Expr.to_dyn e ] in
426
if Marks.(equal empty marks) then base else Marks.to_dyn marks :: base
427
in
428
variant "TExp" e
429
| TMatch m -> variant "TMarks" [ Marks.to_dyn m ]
430
;;
431
432
open E
433
···
85
| `First -> "first"
86
;;
87
88
let equal = Poly.equal
89
let pp ch k = Format.pp_print_string ch (to_string k)
90
end
···
174
| After of Category.t
175
| Pmark of Pmark.t
176
177
+
let wrap_sem sem sem' v =
178
+
let open Dyn in
179
+
let name = Sem.to_string sem' in
180
+
match sem with
181
+
| Some sem when Sem.equal sem sem' -> v
182
+
| None | Some _ ->
183
+
(match v with
184
+
| List v -> variant name v
185
+
| _ -> variant name [ v ])
186
+
;;
187
+
188
+
let rec seq_as_list sem = function
189
+
| Eps -> []
190
+
| Cst cs -> [ Cst cs ]
191
+
| Seq (sem', x, y) ->
192
+
if Sem.equal sem sem'
193
+
then x.def :: seq_as_list sem y.def
194
+
else raise_notrace Not_found
195
+
| _ -> raise_notrace Not_found
196
+
;;
197
+
198
+
let seq_as_list sem t =
199
+
match seq_as_list sem t with
200
+
| exception Not_found -> None
201
+
| s -> Some s
202
+
;;
203
+
204
+
let rec dyn_of_def sem =
205
let open Dyn in
206
function
207
| Cst cset -> Cset.to_dyn cset
208
+
| Alt alt -> variant "Alt" (List.map ~f:(to_dyn sem) alt)
209
+
| Seq (sem', x, y) ->
210
+
let to_dyn = to_dyn (Some sem') in
211
+
let x =
212
+
match seq_as_list sem' y.def with
213
+
| None -> variant "Seq" [ to_dyn x; to_dyn y ]
214
+
| Some y -> variant "Seq" (to_dyn x :: List.map y ~f:(dyn_of_def sem))
215
+
in
216
+
wrap_sem sem sem' x
217
| Eps -> Enum "Eps"
218
+
| Rep (_, sem', t) -> wrap_sem sem sem' (variant "Rep" [ to_dyn (Some sem') t ])
219
| Mark m -> variant "Mark" [ Mark.to_dyn m ]
220
| Pmark m -> variant "Pmark" [ Pmark.to_dyn m ]
221
| Erase (x, y) -> variant "Erase" [ Mark.to_dyn x; Mark.to_dyn y ]
222
| Before c -> variant "Before" [ Category.to_dyn c ]
223
| After c -> variant "After" [ Category.to_dyn c ]
224
225
+
and to_dyn sem { id = _; def } = dyn_of_def sem def
226
227
let with_sem prev next fmt pp () =
228
let open Fmt in
···
447
448
type t = E.t list
449
450
+
let rec to_dyn sem t = Dyn.list (List.map ~f:(dyn_of_e sem) t)
451
452
+
and dyn_of_e sem =
453
let open Dyn in
454
function
455
+
| E.TSeq (sem', x, y) ->
456
+
wrap_sem
457
+
sem
458
+
sem'
459
+
(variant "TSeq" [ to_dyn (Some sem') x; Expr.to_dyn (Some sem') y ])
460
| TExp (marks, e) ->
461
let e =
462
+
let base = [ Expr.to_dyn sem e ] in
463
if Marks.(equal empty marks) then base else Marks.to_dyn marks :: base
464
in
465
variant "TExp" e
466
| TMatch m -> variant "TMarks" [ Marks.to_dyn m ]
467
;;
468
+
469
+
let to_dyn = to_dyn None
470
471
open E
472
+39
-28
lib_test/expect/test_automata.ml
+39
-28
lib_test/expect/test_automata.ml
···
49
loop (State.create cat re) 'a';
50
[%expect
51
{|
52
-
((TExp (Seq first 97 (Seq first 97 (Seq first 97 97)))))
53
-
((TExp (Seq first 97 (Seq first 97 97))))
54
-
((TExp (Seq first 97 97)))
55
((TExp 97))
56
((TExp Eps))
57
((TMarks ()))
58
> matched
59
|}];
60
loop (State.create cat re) 'b';
61
-
[%expect
62
-
{|
63
-
((TExp (Seq first 97 (Seq first 97 (Seq first 97 97)))))
64
()
65
> failed
66
|}]
···
71
let n = 5 in
72
let s = String.make n c in
73
let ids = Ids.create () in
74
-
let re = Automata.alt ids (List.init ~len:n ~f:(fun _ -> str ids `First s)) in
75
let wa = Working_area.create () in
76
let rec loop d c =
77
Format.printf "%a@." pp_state d;
···
86
[%expect
87
{|
88
((TExp
89
-
(Alt (Seq first 97 (Seq first 97 (Seq first 97 (Seq first 97 97))))
90
-
(Seq first 97 (Seq first 97 (Seq first 97 (Seq first 97 97))))
91
-
(Seq first 97 (Seq first 97 (Seq first 97 (Seq first 97 97))))
92
-
(Seq first 97 (Seq first 97 (Seq first 97 (Seq first 97 97))))
93
-
(Seq first 97 (Seq first 97 (Seq first 97 (Seq first 97 97)))))))
94
-
((TExp (Seq first 97 (Seq first 97 (Seq first 97 97))))
95
-
(TExp (Seq first 97 (Seq first 97 (Seq first 97 97))))
96
-
(TExp (Seq first 97 (Seq first 97 (Seq first 97 97))))
97
-
(TExp (Seq first 97 (Seq first 97 (Seq first 97 97))))
98
-
(TExp (Seq first 97 (Seq first 97 (Seq first 97 97)))))
99
-
((TExp (Seq first 97 (Seq first 97 97)))
100
-
(TExp (Seq first 97 (Seq first 97 97)))
101
-
(TExp (Seq first 97 (Seq first 97 97)))
102
-
(TExp (Seq first 97 (Seq first 97 97)))
103
-
(TExp (Seq first 97 (Seq first 97 97))))
104
-
((TExp (Seq first 97 97)) (TExp (Seq first 97 97)) (TExp (Seq first 97 97))
105
-
(TExp (Seq first 97 97)) (TExp (Seq first 97 97)))
106
-
((TExp 97) (TExp 97) (TExp 97) (TExp 97) (TExp 97))
107
-
((TExp Eps))
108
-
((TMarks ()))
109
-
> matched
110
|}]
111
;;
···
49
loop (State.create cat re) 'a';
50
[%expect
51
{|
52
+
((TExp (first (Seq 97 97 97 97))))
53
+
((TExp (first (Seq 97 97 97))))
54
+
((TExp (first (Seq 97 97))))
55
((TExp 97))
56
((TExp Eps))
57
((TMarks ()))
58
> matched
59
|}];
60
loop (State.create cat re) 'b';
61
+
[%expect {|
62
+
((TExp (first (Seq 97 97 97 97))))
63
()
64
> failed
65
|}]
···
70
let n = 5 in
71
let s = String.make n c in
72
let ids = Ids.create () in
73
+
let re =
74
+
Automata.alt
75
+
ids
76
+
(List.init ~len:n ~f:(fun _ ->
77
+
let prefix = str ids `First s in
78
+
let suffix = cst ids (Cset.csingle 'd') in
79
+
seq ids `First prefix suffix))
80
+
in
81
let wa = Working_area.create () in
82
let rec loop d c =
83
Format.printf "%a@." pp_state d;
···
92
[%expect
93
{|
94
((TExp
95
+
(Alt (first (Seq (Seq 97 97 97 97 97) 100))
96
+
(first (Seq (Seq 97 97 97 97 97) 100))
97
+
(first (Seq (Seq 97 97 97 97 97) 100))
98
+
(first (Seq (Seq 97 97 97 97 97) 100))
99
+
(first (Seq (Seq 97 97 97 97 97) 100)))))
100
+
((first (TSeq ((TExp (Seq 97 97 97 97))) 100))
101
+
(first (TSeq ((TExp (Seq 97 97 97 97))) 100))
102
+
(first (TSeq ((TExp (Seq 97 97 97 97))) 100))
103
+
(first (TSeq ((TExp (Seq 97 97 97 97))) 100))
104
+
(first (TSeq ((TExp (Seq 97 97 97 97))) 100)))
105
+
((first (TSeq ((TExp (Seq 97 97 97))) 100))
106
+
(first (TSeq ((TExp (Seq 97 97 97))) 100))
107
+
(first (TSeq ((TExp (Seq 97 97 97))) 100))
108
+
(first (TSeq ((TExp (Seq 97 97 97))) 100))
109
+
(first (TSeq ((TExp (Seq 97 97 97))) 100)))
110
+
((first (TSeq ((TExp (Seq 97 97))) 100))
111
+
(first (TSeq ((TExp (Seq 97 97))) 100))
112
+
(first (TSeq ((TExp (Seq 97 97))) 100))
113
+
(first (TSeq ((TExp (Seq 97 97))) 100))
114
+
(first (TSeq ((TExp (Seq 97 97))) 100)))
115
+
((first (TSeq ((TExp 97)) 100)) (first (TSeq ((TExp 97)) 100))
116
+
(first (TSeq ((TExp 97)) 100)) (first (TSeq ((TExp 97)) 100))
117
+
(first (TSeq ((TExp 97)) 100)))
118
+
((TExp 100) (TExp 100) (TExp 100) (TExp 100) (TExp 100))
119
+
()
120
+
> failed
121
|}]
122
;;