···8585 | `First -> "first"
8686 ;;
87878888- let to_dyn t : Dyn.t = Enum (to_string t)
8988 let equal = Poly.equal
9089 let pp ch k = Format.pp_print_string ch (to_string k)
9190end
···175174 | After of Category.t
176175 | Pmark of Pmark.t
177176178178- let rec dyn_of_def =
177177+ let wrap_sem sem sem' v =
178178+ let open Dyn in
179179+ let name = Sem.to_string sem' in
180180+ match sem with
181181+ | Some sem when Sem.equal sem sem' -> v
182182+ | None | Some _ ->
183183+ (match v with
184184+ | List v -> variant name v
185185+ | _ -> variant name [ v ])
186186+ ;;
187187+188188+ let rec seq_as_list sem = function
189189+ | Eps -> []
190190+ | Cst cs -> [ Cst cs ]
191191+ | Seq (sem', x, y) ->
192192+ if Sem.equal sem sem'
193193+ then x.def :: seq_as_list sem y.def
194194+ else raise_notrace Not_found
195195+ | _ -> raise_notrace Not_found
196196+ ;;
197197+198198+ let seq_as_list sem t =
199199+ match seq_as_list sem t with
200200+ | exception Not_found -> None
201201+ | s -> Some s
202202+ ;;
203203+204204+ let rec dyn_of_def sem =
179205 let open Dyn in
180206 function
181207 | Cst cset -> Cset.to_dyn cset
182182- | Alt alt -> variant "Alt" (List.map ~f:to_dyn alt)
183183- | Seq (sem, x, y) -> variant "Seq" [ Sem.to_dyn sem; to_dyn x; to_dyn y ]
208208+ | Alt alt -> variant "Alt" (List.map ~f:(to_dyn sem) alt)
209209+ | Seq (sem', x, y) ->
210210+ let to_dyn = to_dyn (Some sem') in
211211+ let x =
212212+ match seq_as_list sem' y.def with
213213+ | None -> variant "Seq" [ to_dyn x; to_dyn y ]
214214+ | Some y -> variant "Seq" (to_dyn x :: List.map y ~f:(dyn_of_def sem))
215215+ in
216216+ wrap_sem sem sem' x
184217 | Eps -> Enum "Eps"
185185- | Rep (_, sem, t) -> variant "Rep" [ Sem.to_dyn sem; to_dyn t ]
218218+ | Rep (_, sem', t) -> wrap_sem sem sem' (variant "Rep" [ to_dyn (Some sem') t ])
186219 | Mark m -> variant "Mark" [ Mark.to_dyn m ]
187220 | Pmark m -> variant "Pmark" [ Pmark.to_dyn m ]
188221 | Erase (x, y) -> variant "Erase" [ Mark.to_dyn x; Mark.to_dyn y ]
189222 | Before c -> variant "Before" [ Category.to_dyn c ]
190223 | After c -> variant "After" [ Category.to_dyn c ]
191224192192- and to_dyn { id = _; def } = dyn_of_def def
225225+ and to_dyn sem { id = _; def } = dyn_of_def sem def
193226194227 let with_sem prev next fmt pp () =
195228 let open Fmt in
···414447415448 type t = E.t list
416449417417- let rec to_dyn t = Dyn.list (List.map ~f:dyn_of_e t)
450450+ let rec to_dyn sem t = Dyn.list (List.map ~f:(dyn_of_e sem) t)
418451419419- and dyn_of_e =
452452+ and dyn_of_e sem =
420453 let open Dyn in
421454 function
422422- | E.TSeq (sem, x, y) -> variant "TSeq" [ Sem.to_dyn sem; to_dyn x; Expr.to_dyn y ]
455455+ | E.TSeq (sem', x, y) ->
456456+ wrap_sem
457457+ sem
458458+ sem'
459459+ (variant "TSeq" [ to_dyn (Some sem') x; Expr.to_dyn (Some sem') y ])
423460 | TExp (marks, e) ->
424461 let e =
425425- let base = [ Expr.to_dyn e ] in
462462+ let base = [ Expr.to_dyn sem e ] in
426463 if Marks.(equal empty marks) then base else Marks.to_dyn marks :: base
427464 in
428465 variant "TExp" e
429466 | TMatch m -> variant "TMarks" [ Marks.to_dyn m ]
430467 ;;
468468+469469+ let to_dyn = to_dyn None
431470432471 open E
433472
+39-28
lib_test/expect/test_automata.ml
···4949 loop (State.create cat re) 'a';
5050 [%expect
5151 {|
5252- ((TExp (Seq first 97 (Seq first 97 (Seq first 97 97)))))
5353- ((TExp (Seq first 97 (Seq first 97 97))))
5454- ((TExp (Seq first 97 97)))
5252+ ((TExp (first (Seq 97 97 97 97))))
5353+ ((TExp (first (Seq 97 97 97))))
5454+ ((TExp (first (Seq 97 97))))
5555 ((TExp 97))
5656 ((TExp Eps))
5757 ((TMarks ()))
5858 > matched
5959 |}];
6060 loop (State.create cat re) 'b';
6161- [%expect
6262- {|
6363- ((TExp (Seq first 97 (Seq first 97 (Seq first 97 97)))))
6161+ [%expect {|
6262+ ((TExp (first (Seq 97 97 97 97))))
6463 ()
6564 > failed
6665 |}]
···7170 let n = 5 in
7271 let s = String.make n c in
7372 let ids = Ids.create () in
7474- let re = Automata.alt ids (List.init ~len:n ~f:(fun _ -> str ids `First s)) in
7373+ let re =
7474+ Automata.alt
7575+ ids
7676+ (List.init ~len:n ~f:(fun _ ->
7777+ let prefix = str ids `First s in
7878+ let suffix = cst ids (Cset.csingle 'd') in
7979+ seq ids `First prefix suffix))
8080+ in
7581 let wa = Working_area.create () in
7682 let rec loop d c =
7783 Format.printf "%a@." pp_state d;
···8692 [%expect
8793 {|
8894 ((TExp
8989- (Alt (Seq first 97 (Seq first 97 (Seq first 97 (Seq first 97 97))))
9090- (Seq first 97 (Seq first 97 (Seq first 97 (Seq first 97 97))))
9191- (Seq first 97 (Seq first 97 (Seq first 97 (Seq first 97 97))))
9292- (Seq first 97 (Seq first 97 (Seq first 97 (Seq first 97 97))))
9393- (Seq first 97 (Seq first 97 (Seq first 97 (Seq first 97 97)))))))
9494- ((TExp (Seq first 97 (Seq first 97 (Seq first 97 97))))
9595- (TExp (Seq first 97 (Seq first 97 (Seq first 97 97))))
9696- (TExp (Seq first 97 (Seq first 97 (Seq first 97 97))))
9797- (TExp (Seq first 97 (Seq first 97 (Seq first 97 97))))
9898- (TExp (Seq first 97 (Seq first 97 (Seq first 97 97)))))
9999- ((TExp (Seq first 97 (Seq first 97 97)))
100100- (TExp (Seq first 97 (Seq first 97 97)))
101101- (TExp (Seq first 97 (Seq first 97 97)))
102102- (TExp (Seq first 97 (Seq first 97 97)))
103103- (TExp (Seq first 97 (Seq first 97 97))))
104104- ((TExp (Seq first 97 97)) (TExp (Seq first 97 97)) (TExp (Seq first 97 97))
105105- (TExp (Seq first 97 97)) (TExp (Seq first 97 97)))
106106- ((TExp 97) (TExp 97) (TExp 97) (TExp 97) (TExp 97))
107107- ((TExp Eps))
108108- ((TMarks ()))
109109- > matched
9595+ (Alt (first (Seq (Seq 97 97 97 97 97) 100))
9696+ (first (Seq (Seq 97 97 97 97 97) 100))
9797+ (first (Seq (Seq 97 97 97 97 97) 100))
9898+ (first (Seq (Seq 97 97 97 97 97) 100))
9999+ (first (Seq (Seq 97 97 97 97 97) 100)))))
100100+ ((first (TSeq ((TExp (Seq 97 97 97 97))) 100))
101101+ (first (TSeq ((TExp (Seq 97 97 97 97))) 100))
102102+ (first (TSeq ((TExp (Seq 97 97 97 97))) 100))
103103+ (first (TSeq ((TExp (Seq 97 97 97 97))) 100))
104104+ (first (TSeq ((TExp (Seq 97 97 97 97))) 100)))
105105+ ((first (TSeq ((TExp (Seq 97 97 97))) 100))
106106+ (first (TSeq ((TExp (Seq 97 97 97))) 100))
107107+ (first (TSeq ((TExp (Seq 97 97 97))) 100))
108108+ (first (TSeq ((TExp (Seq 97 97 97))) 100))
109109+ (first (TSeq ((TExp (Seq 97 97 97))) 100)))
110110+ ((first (TSeq ((TExp (Seq 97 97))) 100))
111111+ (first (TSeq ((TExp (Seq 97 97))) 100))
112112+ (first (TSeq ((TExp (Seq 97 97))) 100))
113113+ (first (TSeq ((TExp (Seq 97 97))) 100))
114114+ (first (TSeq ((TExp (Seq 97 97))) 100)))
115115+ ((first (TSeq ((TExp 97)) 100)) (first (TSeq ((TExp 97)) 100))
116116+ (first (TSeq ((TExp 97)) 100)) (first (TSeq ((TExp 97)) 100))
117117+ (first (TSeq ((TExp 97)) 100)))
118118+ ((TExp 100) (TExp 100) (TExp 100) (TExp 100) (TExp 100))
119119+ ()
120120+ > failed
110121 |}]
111122;;