Source file cst.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
91
92
93
94
open Stdune
module Comment = Lexer.Token.Comment

type t =
  | Atom of Loc.t * Atom.t
  | Quoted_string of Loc.t * string
  | Template of Template.t
  | List of Loc.t * t list
  | Comment of Loc.t * Comment.t

let rec to_dyn =
  let open Dyn.Encoder in
  function
  | Atom (_, a) -> constr "Atom" [ Atom.to_dyn a ]
  | Quoted_string (_, s) -> constr "Quoted_string" [ string s ]
  | Template t -> constr "Template" [ Template.to_dyn t ]
  | List (_, l) -> constr "List" [ list to_dyn l ]
  | Comment (_, c) -> constr "Comment" [ Comment.to_dyn c ]

let loc
    ( Atom (loc, _)
    | Quoted_string (loc, _)
    | List (loc, _)
    | Template { loc; _ }
    | Comment (loc, _) ) =
  loc

let fetch_legacy_comments t ~file_contents =
  let rec loop t =
    match t with
    | Template _
    | Quoted_string _
    | Atom _
    | Comment (_, Lines _) ->
      t
    | List (loc, l) -> List (loc, List.map l ~f:loop)
    | Comment (loc, Legacy) ->
      let start = loc.start.pos_cnum in
      let stop = loc.stop.pos_cnum in
      let s =
        if file_contents.[start] = '#' && file_contents.[start + 1] = '|' then
          String.sub file_contents ~pos:(start + 2) ~len:(stop - start - 4)
        else
          String.sub file_contents ~pos:start ~len:(stop - start)
      in
      Comment (loc, Lines (String.split s ~on:'\n'))
  in
  loop t

let rec abstract : t -> Ast.t option = function
  | Atom (loc, atom) -> Some (Atom (loc, atom))
  | Quoted_string (loc, s) -> Some (Quoted_string (loc, s))
  | Template t -> Some (Template t)
  | List (loc, l) -> Some (List (loc, List.filter_map ~f:abstract l))
  | Comment _ -> None

let rec concrete : Ast.t -> t = function
  | Atom (loc, atom) -> Atom (loc, atom)
  | Quoted_string (loc, s) -> Quoted_string (loc, s)
  | Template t -> Template t
  | List (loc, l) -> List (loc, List.map ~f:concrete l)

let to_sexp c = abstract c |> Option.map ~f:Ast.remove_locs

let extract_comments =
  let rec loop acc = function
    | Atom _
    | Quoted_string _
    | Template _ ->
      acc
    | List (_, l) -> List.fold_left l ~init:acc ~f:loop
    | Comment (loc, comment) -> (loc, comment) :: acc
  in
  List.fold_left ~init:[] ~f:loop

let tokenize ts =
  let tokens = ref [] in
  let emit loc (token : Lexer.Token.t) = tokens := (loc, token) :: !tokens in
  let rec iter = function
    | Atom (loc, s) -> emit loc (Atom s)
    | Quoted_string (loc, s) -> emit loc (Quoted_string s)
    | Template ({ loc; _ } as template) -> emit loc (Template template)
    | Comment (loc, comment) -> emit loc (Comment comment)
    | List (loc, l) ->
      emit
        { loc with stop = { loc.start with pos_cnum = loc.start.pos_cnum + 1 } }
        Lparen;
      List.iter l ~f:iter;
      emit
        { loc with start = { loc.stop with pos_cnum = loc.stop.pos_cnum - 1 } }
        Rparen
  in
  List.iter ts ~f:iter;
  List.rev !tokens