Source file view.ml

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
open Import

module Cset = struct
  include Cset

  module Range = struct
    type t =
      { first : Char.t
      ; last : Char.t
      }

    let first t = t.first
    let last t = t.last
  end

  let view t =
    fold_right t ~init:[] ~f:(fun first last acc ->
      let range = { Range.first = Cset.to_char first; last = Cset.to_char last } in
      range :: acc)
  ;;
end

module Sem = Automata.Sem
module Rep_kind = Automata.Rep_kind

type t =
  | Set of Cset.t
  | Sequence of Ast.t list
  | Alternative of Ast.t list
  | Repeat of Ast.t * int * int option
  | Beg_of_line
  | End_of_line
  | Beg_of_word
  | End_of_word
  | Not_bound
  | Beg_of_str
  | End_of_str
  | Last_end_of_line
  | Start
  | Stop
  | Sem of Automata.Sem.t * Ast.t
  | Sem_greedy of Automata.Rep_kind.t * Ast.t
  | Group of string option * Ast.t
  | No_group of Ast.t
  | Nest of Ast.t
  | Case of Ast.t
  | No_case of Ast.t
  | Intersection of Ast.t list
  | Complement of Ast.t list
  | Difference of Ast.t * Ast.t
  | Pmark of Pmark.t * Ast.t

let view_ast f (t : _ Ast.ast) : t =
  match t with
  | Alternative a -> Alternative (List.map ~f a)
  | No_case a -> No_case (f a)
  | Case a -> Case (f a)
;;

let view_set (cset : Ast.cset) : t =
  match cset with
  | Cset set -> Set set
  | Intersection sets -> Intersection (List.map sets ~f:Ast.t_of_cset)
  | Complement sets -> Complement (List.map sets ~f:Ast.t_of_cset)
  | Difference (x, y) -> Difference (Ast.t_of_cset x, Ast.t_of_cset y)
  | Cast ast -> view_ast Ast.t_of_cset ast
;;

let view : Ast.t -> t = function
  | Set s -> view_set s
  | Ast s -> view_ast (fun x -> x) s
  | Sem (sem, a) -> Sem (sem, a)
  | Sem_greedy (sem, a) -> Sem_greedy (sem, a)
  | Sequence s -> Sequence s
  | Repeat (t, x, y) -> Repeat (t, x, y)
  | Beg_of_line -> Beg_of_line
  | End_of_line -> End_of_line
  | Beg_of_word -> Beg_of_word
  | End_of_word -> End_of_word
  | Not_bound -> Not_bound
  | Beg_of_str -> Beg_of_str
  | End_of_str -> End_of_str
  | Last_end_of_line -> Last_end_of_line
  | Start -> Start
  | Stop -> Stop
  | No_group a -> No_group a
  | Group (name, t) -> Group (name, t)
  | Nest t -> Nest t
  | Pmark (pmark, t) -> Pmark (pmark, t)
;;