Commit 44e790f3 authored by POTTIER Francois's avatar POTTIER Francois

Add [VisitorsCompatibility], which (using cppo) allows compatibility with 4.02.

parent 7d201c5d
2017/04/04:
Extended backward compatibility to OCaml 4.02. (Thanks to Benjamin Farinier.)
2017/03/17:
New attributes [@build] and [@@build] can be attached to record type
declarations and data constructors, so as to alter the construction code that
......
......@@ -18,8 +18,9 @@ remove: [
depends: [
"ocamlfind"
"ocamlbuild" {build}
"cppo" {build}
"ppx_tools"
"ppx_deriving" {>= "4.0"}
"result"
]
available: [ ocaml-version >= "4.03" ]
available: [ ocaml-version >= "4.02" ]
......@@ -15,6 +15,7 @@ OCAMLBUILD := \
ocamlbuild \
-use-ocamlfind \
-classic-display \
-plugin-tag 'package(cppo_ocamlbuild)' \
# The targets that should be built (using ocamlbuild).
# Not sure whether all of the following files are really required.
......
......@@ -7,6 +7,7 @@ open Ast_helper
open Ast_convenience
open Ppx_deriving
open VisitorsPlugin
open VisitorsCompatibility
open VisitorsAnalysis
open VisitorsGeneration
open VisitorsSettings
......@@ -1000,15 +1001,14 @@ let constructor_declaration decl (cd : constructor_declaration) : case =
*)
let xss, tys, pss, (builder : builder) =
match cd.pcd_args with
match data_constructor_variety cd with
(* A traditional data constructor. *)
| Pcstr_tuple tys ->
| DataTraditional tys ->
let xss = componentss tys in
let pss = transpose arity (pvarss xss) in
xss, tys, pss, fun rs -> constr datacon (evars rs)
(* An ``inline record'' data constructor. *)
| Pcstr_record lds ->
let labels, tys = ld_labels lds, ld_tys lds in
| DataInlineRecord (labels, tys) ->
let xss = fieldss labels in
let pss = transpose arity (pvarss xss) in
xss, tys,
......
......@@ -162,21 +162,6 @@ let fix =
(* -------------------------------------------------------------------------- *)
(* [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
(* [type_param_to_tyvar] expects a type parameter as found in the field
[ptype_params] of a type definition, and returns the underlying type
variable. *)
......@@ -286,9 +271,9 @@ and occurs_quantifiers alpha qs =
and occurs_payload alpha = function
| PTyp ty ->
occurs_type alpha ty
| PStr _
| PSig _
| PPat _ ->
(* | PStr _ | PPat _ *)
(* | PSig _ (* >= 4.03 *) *)
| _ ->
(* We assume that these cases won't arise or won't have any free type
variables in them. *)
()
......
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. *)
#if OCAML_VERSION < (4, 03, 0)
#define Nolabel ""
#endif
(* 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) =
#if OCAML_VERSION < (4, 03, 0)
Const_string (w, None)
#else
Const.string w
#endif
(* [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) =
#if OCAML_VERSION < (4, 03, 0)
DataTraditional cd.pcd_args
#else
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)
#endif
open Longident
open Location
let mknoloc = Location.mknoloc
open Asttypes
open Parsetree
open Ast_helper
open Ast_convenience
open VisitorsList
open VisitorsAnalysis
open VisitorsCompatibility
(* This module offers helper functions for code generation. *)
......@@ -76,8 +77,7 @@ let ty_any =
let ty_unit =
tconstr "unit" []
let ty_arrow (a : core_type) (b : core_type) : core_type =
Typ.arrow Nolabel a b
(* For [ty_arrow], see [VisitorsCompatibility]. *)
let ty_arrows : core_types -> core_type -> core_type =
List.fold_right ty_arrow
......@@ -157,8 +157,7 @@ let wildcards xs =
(* [plambda p e] constructs a function [fun p -> e]. *)
let plambda (p : pattern) (e : expression) : expression =
Exp.fun_ Nolabel None p e
(* For [plambda], see [VisitorsCompatibility]. *)
(* [lambda x e] constructs a function [fun x -> e]. *)
......@@ -380,7 +379,7 @@ let floating (s : string) (items : structure) : structure_item =
let with_warnings (w : string) (items : structure_item list) : structure_item =
include_ (Mod.structure (
floating "ocaml.warning" [ Str.eval (Exp.constant (Const.string w)) ]
floating "ocaml.warning" [ Str.eval (Exp.constant (const_string w)) ]
:: items
))
......
......@@ -2,7 +2,8 @@ true: \
debug, \
safe_string, \
warn(A-4-44), \
package(result)
package(result), \
cppo_V_OCAML
not <VisitorsRuntime.*>: \
package(compiler-libs.common), \
......
(* This means: please use [cppo] to generate [%.ml] from [%.cppo.ml]. *)
let () =
Ocamlbuild_plugin.dispatch (fun phase ->
Ocamlbuild_cppo.dispatcher phase
)
VisitorsCompatibility
VisitorsList
VisitorsString
VisitorsPlugin
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment