Source file utils.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
114
115
116
open Import

let with_output fn ~binary ~f =
  match fn with
  | None | Some "-" -> f stdout
  | Some fn -> Out_channel.with_file fn ~binary ~f
;;

module Kind = struct
  type t = Intf | Impl

  let of_filename fn : t option =
    if Caml.Filename.check_suffix fn ".ml" then
      Some Impl
    else if Caml.Filename.check_suffix fn ".mli" then
      Some Intf
    else
      None
  ;;

  let describe = function
    | Impl -> "implementation"
    | Intf -> "interface"
  ;;

  let equal : t -> t -> bool = Poly.equal
end

module Some_intf_or_impl = struct
  type t =
    | Intf of Migrate_parsetree.Driver.some_signature
    | Impl of Migrate_parsetree.Driver.some_structure

  let to_ast_io (ast : t) ~add_ppx_context =
    let open Migrate_parsetree in
    match ast with
    | Intf (Migrate_parsetree.Driver.Sig ((module Ver), sg)) ->
      let sg =
        (Migrate_parsetree.Versions.migrate
           (module Ver)
           (module Versions.OCaml_current)).copy_signature sg
      in
      let sg =
        if add_ppx_context then
          Ocaml_common.Ast_mapper.add_ppx_context_sig ~tool_name:"ppxlib_driver" sg
        else
          sg
      in
      Ast_io.Intf ((module Versions.OCaml_current), sg)
    | Impl (Migrate_parsetree.Driver.Str ((module Ver), st)) ->
      let st =
        (Migrate_parsetree.Versions.migrate
                      (module Ver)
                      (module Versions.OCaml_current)).copy_structure st
      in
      let st =
        if add_ppx_context then
          Ocaml_common.Ast_mapper.add_ppx_context_str ~tool_name:"ppxlib_driver" st
        else
          st
      in
      Ast_io.Impl ((module Versions.OCaml_current), st)
end

module Intf_or_impl = struct
  type t =
    | Intf of signature
    | Impl of structure

  let map t (map : Ast_traverse.map) =
    match t with
    | Impl x -> Impl (map#structure x)
    | Intf x -> Intf (map#signature x)
  ;;

  let map_with_context t (map : _ Ast_traverse.map_with_context) ctx =
    match t with
    | Impl x -> Impl (map#structure ctx x)
    | Intf x -> Intf (map#signature ctx x)
  ;;

  let kind : _ -> Kind.t = function
    | Intf _ -> Intf
    | Impl _ -> Impl

  let of_some_intf_or_impl ast : t =
    let open Some_intf_or_impl in
    match ast with
    | Intf (Migrate_parsetree.Driver.Sig ((module Ver), sg)) ->
      Intf ((Migrate_parsetree.Versions.migrate (module Ver)
               (module Ppxlib_ast.Selected_ast)).copy_signature sg)
    | Impl (Migrate_parsetree.Driver.Str ((module Ver), st)) ->
      Impl ((Migrate_parsetree.Versions.migrate (module Ver)
               (module Ppxlib_ast.Selected_ast)).copy_structure st)

  let of_ast_io ast : t =
    let open Migrate_parsetree in
    match ast with
    | Ast_io.Intf ((module Ver), sg) ->
      let module C = Versions.Convert(Ver)(Ppxlib_ast.Selected_ast) in
      Intf (C.copy_signature sg)
    | Ast_io.Impl ((module Ver), st) ->
      let module C = Versions.Convert(Ver)(Ppxlib_ast.Selected_ast) in
      Impl (C.copy_structure st)
end
(*
let map_impl x ~(f : _ Intf_or_impl.t -> _ Intf_or_impl.t) =
  match f (Impl x) with
  | Impl x -> x
  | Intf _ -> assert false

let map_intf x ~(f : _ Intf_or_impl.t -> _ Intf_or_impl.t) =
  match f (Intf x) with
  | Intf x -> x
  | Impl _ -> assert false
*)