Source file Chunk.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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
(**************************************************************************)
(*                                                                        *)
(*                              OCamlFormat                               *)
(*                                                                        *)
(*            Copyright (c) Facebook, Inc. and its affiliates.            *)
(*                                                                        *)
(*      This source code is licensed under the MIT license found in       *)
(*      the LICENSE file in the root directory of this source tree.       *)
(*                                                                        *)
(**************************************************************************)

open Extended_ast

type 'a item =
  | Structure : Extended_ast.structure item
  | Signature : Extended_ast.signature item
  | Use_file : Extended_ast.use_file item

type 'a t =
  { attr_loc: Location.t
  ; chunk_loc: Location.t
  ; state: [`Enable | `Disable]
  ; items: 'a list }

let init_loc =
  let pos =
    Lexing.
      {pos_cnum= 0; pos_bol= 0; pos_lnum= 0; pos_fname= !Location.input_name}
  in
  Location.{loc_ghost= false; loc_start= pos; loc_end= pos}

let is_attr (type a) (fg : a list item) (x : a) =
  match (fg, x) with
  | Structure, {pstr_desc= Pstr_attribute x; pstr_loc} -> Some (x, pstr_loc)
  | Signature, {psig_desc= Psig_attribute x; psig_loc} -> Some (x, psig_loc)
  | Use_file, Ptop_def ({pstr_desc= Pstr_attribute x; pstr_loc} :: _) ->
      Some (x, pstr_loc)
  | _ -> None

let is_state_attr fg ~state x =
  let open Option.Monad_infix in
  is_attr fg x
  >>= fun (attr, loc) ->
  Conf.parse_state_attr attr
  >>= fun new_state ->
  match (state, new_state) with
  | `Enable, `Disable -> Some (`Disable, loc)
  | `Disable, `Enable -> Some (`Enable, loc)
  | _ -> None

let last_loc (type a) (fg : a list item) (l : a list) =
  let open Option.Monad_infix in
  match fg with
  | Structure -> List.last l >>| fun x -> x.pstr_loc
  | Signature -> List.last l >>| fun x -> x.psig_loc
  | Use_file -> (
      List.last l
      >>= function
      | Ptop_def x -> List.last x >>| fun x -> x.pstr_loc
      | Ptop_dir x -> Some x.pdir_loc )

let mk ~attr_loc ~chunk_loc state items = {attr_loc; chunk_loc; state; items}

let mk_tmp ~loc state items = mk ~attr_loc:loc ~chunk_loc:loc state items

(* Build chunks of each disabled/enabled code spans. The [chunk_loc] of each
   chunk has an unprecise ending position that needs to be set after looking
   at the following chunk. *)
let split_with_imprecise_locs fg ~state l =
  let init = ([], state) in
  let chunks, _ =
    List.fold_left l ~init ~f:(fun (acc, state) x ->
        match is_state_attr fg ~state x with
        | Some (state, loc) -> (mk_tmp ~loc state [x] :: acc, state)
        | None -> (
          match acc with
          (* first chunk *)
          | [] -> (mk_tmp ~loc:init_loc state [x] :: acc, state)
          | chunk :: t -> ({chunk with items= x :: chunk.items} :: t, state)
          ) )
  in
  List.rev_map chunks ~f:(fun x -> {x with items= List.rev x.items})

(* Extend the [chunk_loc] to make it span until the start of [last_loc]. *)
let extend_end_loc ~last_loc chunk =
  let loc_end = last_loc.Location.loc_start in
  let chunk_loc = {chunk.chunk_loc with loc_end} in
  {chunk with chunk_loc}

(* Update the [chunk_loc] of each chunk by using the loc of the following
   chunk. *)
let extend_end_locs fg l =
  match List.rev l with
  | [] -> []
  | h :: t ->
      (* last chunk *)
      let init =
        let last_loc =
          Option.value (last_loc fg h.items) ~default:h.chunk_loc
        in
        let chunk_loc = {h.chunk_loc with loc_end= last_loc.loc_end} in
        let h = {h with chunk_loc} in
        (h.attr_loc, [h])
      in
      let _, chunks =
        List.fold_left t ~init ~f:(fun (last_loc, acc) chunk ->
            let chunk = extend_end_loc ~last_loc chunk in
            (chunk.attr_loc, chunk :: acc) )
      in
      chunks

let split ~state fg l =
  extend_end_locs fg @@ split_with_imprecise_locs fg ~state l