Source file VisitorsCompatibility.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
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
# 1 "VisitorsCompatibility.cppo.ml"
let mknoloc = Location.mknoloc
open Asttypes
open Parsetree
open Ast_helper

(* OCaml's abstract syntax tree evolves with time. We depend on this tree
   because we analyze it (that is, we analyze type definitions) and because we
   construct it (that is, we generate code). This module gathers the ugly bits
   whose definition varies depending on the version of OCaml that we are
   working with. *)


# 16 "VisitorsCompatibility.cppo.ml"
(* Constructing an arrow type. *)

let ty_arrow (a : core_type) (b : core_type) : core_type =
  Typ.arrow Nolabel a b

(* Constructing a function. *)

let plambda (p : pattern) (e : expression) : expression =
  Exp.fun_ Nolabel None p e

(* Constructing a string literal. *)

let const_string (w : string) =
  
# 32 "VisitorsCompatibility.cppo.ml"
  Const.string w

# 35 "VisitorsCompatibility.cppo.ml"
(* [ld_label] and [ld_ty] extract a label and type out of an OCaml record label
   declaration. *)

let ld_label (ld : label_declaration) : label =
  ld.pld_name.txt

let ld_labels =
  List.map ld_label

let ld_ty (ld : label_declaration) : core_type =
  ld.pld_type

let ld_tys =
  List.map ld_ty

(* Analyzing the definition of a data constructor. *)

(* A data constructor is either a traditional data constructor, whose
   components are anonymous, or a data constructor whose components
   form an ``inline record''. This is a new feature of OCaml 4.03. *)

type data_constructor_variety =
  | DataTraditional of core_type list
  | DataInlineRecord of label list * core_type list

let data_constructor_variety (cd : constructor_declaration) =
    
# 64 "VisitorsCompatibility.cppo.ml"
    match cd.pcd_args with
    (* A traditional data constructor. *)
    | Pcstr_tuple tys ->
        DataTraditional tys
    (* An ``inline record'' data constructor. *)
    | Pcstr_record lds ->
        DataInlineRecord (ld_labels lds, ld_tys lds)

# 73 "VisitorsCompatibility.cppo.ml"
(* Between OCaml 4.04 and OCaml 4.05, the types of several functions in [Ast_helper]
   have changed. They used to take arguments of type [string], and now take arguments
   of type [str], thus requiring a conversion. These functions include [Typ.object_],
   [Typ.poly], [Exp.send], [Exp.newtype], [Ctf.val_], [Ctf.method_], [Cf.inherit_].  *)

type str =
    
# 82 "VisitorsCompatibility.cppo.ml"
    string Location.loc

# 85 "VisitorsCompatibility.cppo.ml"
let string2str (s : string) : str =
    
# 89 "VisitorsCompatibility.cppo.ml"
    mknoloc s

# 92 "VisitorsCompatibility.cppo.ml"
let str2string (s : str) : string =
    
# 96 "VisitorsCompatibility.cppo.ml"
    s.txt

# 99 "VisitorsCompatibility.cppo.ml"
let typ_poly (tyvars : string list) (cty : core_type) : core_type =
  Typ.poly (List.map string2str tyvars) cty

let exp_send (e : expression) (m : string) : expression =
  Exp.send e (string2str m)

(* In the data constructor [Ptyp_poly (qs, ty)], the type of [qs] has changed from
   [string list] to [string loc list] between OCaml 4.04 and 4.05.
   See commit b0e880c448c78ed0cedff28356fcaf88f1436eef.
   The function [quantifiers] compensates for this. *)

let quantifiers qs : string list =
  List.map str2string qs

(* In the data constructor [Ptyp_object (methods, _)], the type of [methods] has
   changed from [(string loc * attributes * core_type) list] in OCaml 4.05 to
                [object_field                          list] in OCaml 4.06. *)



# 123 "VisitorsCompatibility.cppo.ml"
let object_field_to_core_type (field : object_field) : core_type =
    
# 135 "VisitorsCompatibility.cppo.ml"
    match field.pof_desc with
    | Otag (_, ty)  -> ty
    | Oinherit ty   -> ty

# 140 "VisitorsCompatibility.cppo.ml"
let row_field_to_core_types (field : row_field) : core_type list =
  
# 148 "VisitorsCompatibility.cppo.ml"
  match field.prf_desc with
  | Rtag (_, _, tys) ->
      tys
  | Rinherit ty ->
      [ ty ]

# 155 "VisitorsCompatibility.cppo.ml"
(* -------------------------------------------------------------------------- *)

(* [floating s items] produces a floating attribute whose name is [s] and
   whose payload is the list of structure items [items]. *)

(* The type [attribute] is defined in 4.07 as [string loc * payload], but in
   4.08 its definition changes to a record type and the function [Attr.mk]
   appears. *)

let floating (s : string) (items : structure) : structure_item =
  let name = mknoloc s
  and payload = PStr items in
  
# 170 "VisitorsCompatibility.cppo.ml"
  Str.attribute (Attr.mk name payload)