This is an automated email from the git hooks/post-receive script. treinen pushed a commit to branch master in repository ocaml-visitors.
commit 024ae8b24a6d76a3424ba8dab98031807abaec26 Author: Ralf Treinen <trei...@free.fr> Date: Wed Mar 21 08:26:58 2018 +0100 New upstream version 20180306 --- CHANGES.md | 18 +++++++ GNUmakefile | 15 +++++- TODO | 8 ++++ doc/main.tex | 7 +++ src/Visitors.ml | 74 ++++++++++++++++++++++++++--- src/VisitorsAnalysis.ml | 25 +++++----- src/VisitorsCompatibility.cppo.ml | 63 ++++++++++++++++++++++++ src/VisitorsGeneration.ml | 2 +- src/VisitorsString.ml | 43 +++++++++++++++++ test/bad/Makefile | 7 +++ test/bad/conflict.ml | 25 ++++++++++ test/bad/conflict_at_name.ml | 17 +++++++ test/bad/conflict_atat_name.ml | 15 ++++++ test/bad/datacon.ml | 11 +++++ test/bad/datacon_at_name.ml | 10 ++++ test/bad/visitors.t | 49 +++++++++++++++++++ test/expr.mllib | 1 + test/expr01use.ml | 1 + test/{expr01use.ml => expr01use_variant.ml} | 16 +++---- 19 files changed, 375 insertions(+), 32 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index eea14f5..cae0e4c 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,5 +1,23 @@ # Changes +## 2018/03/06 + +* Warn when the visitor methods for two distinct types or two distinct data + constructors have the same name, as this results in an OCaml type error + or multiply-defined-method error. (Reported by Gabriel Radanne.) + +## 2017/11/24 + +* Added compatibility with OCaml 4.06.0. + +* Fixed the internal function `occurs_type` in the case of polymorphic types. + This should make no observable difference, as this function is used only + to produce an error message in a corner case. + +## 2017/08/28 + +* Added compatibility with OCaml 4.05.0. + ## 2017/07/25 * Updated `src/Makefile` to allow compilation on systems where `ocamlopt` is diff --git a/GNUmakefile b/GNUmakefile index b2e3c38..8b4f543 100644 --- a/GNUmakefile +++ b/GNUmakefile @@ -5,7 +5,7 @@ SHELL := bash export CDPATH= -.PHONY: package check export tag opam pin unpin +.PHONY: package check export tag opam pin unpin versions # ------------------------------------------------------------------------- @@ -158,3 +158,16 @@ pin: unpin: opam pin remove visitors + +# ------------------------------------------------------------------------- + +# Trying out compilation under multiple versions of OCaml. + +versions: + for i in 4.02.3 4.03.0 4.04.0 4.05.0 4.06.0 ; do \ + opam switch $$i && eval `opam config env` && ocamlc -v && \ + opam install hashcons ppx_deriving ppx_import ocp-indent && \ + make clean && \ + make && \ + make reinstall ; \ + done diff --git a/TODO b/TODO index e320c0b..42d6370 100644 --- a/TODO +++ b/TODO @@ -8,6 +8,14 @@ Better clean up & share code at the three call sites of [bulk]. TODO (PERHAPS) +Philip's question: when you compose two transformations formulated as map +visitors, can you deforest? (eliminate the allocation of the intermediate +tree) + +Document Jonathan's example where every node in an "expression" carries a type +and the visitor for expressions carries the type down (whereas the visitor for +types doesn't). https://github.com/FStarLang/kremlin/blob/visitors/src/Ast.ml + Document hexpr_polymorphic. Make VisitorsHashcons available as a library. If there is an error, then the warnings are never seen, diff --git a/doc/main.tex b/doc/main.tex index eaacde6..6b9cf3f 100644 --- a/doc/main.tex +++ b/doc/main.tex @@ -132,6 +132,13 @@ Finally, a user of \merlin should add the following lines in her project's PKG visitors.ppx PKG visitors.runtime \end{lstlisting} +To use the \visitors package in OCaml's interactive ``toplevel'' environment, +launch \texttt{ocaml} and type the following commands: +\begin{lstlisting} + #use "topfind";; + #require "visitors.ppx";; + #require "visitors.runtime";; +\end{lstlisting} % ------------------------------------------------------------------------------ diff --git a/src/Visitors.ml b/src/Visitors.ml index 0ad37aa..b459b78 100644 --- a/src/Visitors.ml +++ b/src/Visitors.ml @@ -1,3 +1,4 @@ +open VisitorsString open VisitorsList open Longident open List @@ -82,6 +83,44 @@ let sum_build_warning (decl : type_declaration) : unit = (* -------------------------------------------------------------------------- *) +(* Shared glue code for detecting and warning against name clashes. *) + +type 'a wrapper = + 'a -> 'a + +type tycon_visitor_method = + Location.t * attributes * Longident.t -> methode + +let protect_tycon_visitor_method : tycon_visitor_method wrapper = + fun tycon_visitor_method -> + let format : (_, _, _, _) format4 = + "%s: name clash: the types %s and %s\n\ + both have visitor methods named %s.\n\ + Please consider using [@@name] at type declaration sites\n\ + or [@name] at type reference sites." + in + let id = print_longident in + protect tycon_visitor_method + (fun (_, _, x) (_, _, y) -> x = y) + (fun (_, _, x) (loc, _, y) m -> warning loc format plugin (id x) (id y) m) + +type datacon_descending_method = + constructor_declaration -> methode + +let protect_datacon_descending_method : datacon_descending_method wrapper = + fun datacon_descending_method -> + let format : (_, _, _, _) format4 = + "%s: name clash: the data constructors %s and %s\n\ + both have visitor methods named %s.\n\ + Please consider using [@name] at data constructor declaration sites." + in + let id cd = cd.pcd_name.txt in + protect datacon_descending_method + (fun cd1 cd2 -> cd1 == cd2) + (fun cd1 cd2 m -> warning cd2.pcd_loc format plugin (id cd1) (id cd2) m) + +(* -------------------------------------------------------------------------- *) + (* We support parameterized type declarations. We require them to be regular. That is, for instance, if a type ['a term] is being defined, then every use of [_ term] in the definition should be ['a term]; it cannot be, say, @@ -125,6 +164,10 @@ let check_regularity loc tycon (formals : tyvars) (actuals : core_types) = nonlocal type, a [@name] attribute must be attached to every reference to this type. + The [@name] attribute can be misused: e.g., one can mistakenly use + different visitor method names for different occurrences of a single type. + We currently do not attempt to detect this situation. + The prefix that is prepended to the base name can be controlled via the settings [visit_prefix], [build_prefix], and [fail_prefix]. *) @@ -144,16 +187,32 @@ let datacon_modified_name (cd : constructor_declaration) : datacon = (* The name of this method is normally [visit_foo] if the type is named [foo] or [A.foo]. (A qualified name must denote a nonlocal type.) *) -let tycon_visitor_method (attrs : attributes) (tycon : tycon) : methode = - X.visit_prefix ^ tycon_modified_name attrs tycon +(* This convention can cause name clashes, as the types [foo] and [A.foo] + receive visitor methods by the same name. We warn if this happens. + + A name clash can also be caused by incorrect use of the [@@name] or + [@name] attributes. We also warn if this happens. *) + +(* Step 1 -- the raw convention. *) + +let tycon_visitor_method : tycon_visitor_method = + fun (_, attrs, tycon) -> + X.visit_prefix ^ tycon_modified_name attrs (Longident.last tycon) + +(* Step 2 -- protect against name clashes. *) + +let tycon_visitor_method = + protect_tycon_visitor_method tycon_visitor_method + +(* Step 3 -- define auxiliary functions that are easier to use. *) let local_tycon_visitor_method (decl : type_declaration) : methode = - tycon_visitor_method decl.ptype_attributes decl.ptype_name.txt + tycon_visitor_method (decl.ptype_loc, decl.ptype_attributes, Lident decl.ptype_name.txt) let nonlocal_tycon_visitor_method (ty : core_type) : methode = match ty.ptyp_desc with | Ptyp_constr (tycon, _) -> - tycon_visitor_method ty.ptyp_attributes (Longident.last tycon.txt) + tycon_visitor_method (ty.ptyp_loc, ty.ptyp_attributes, tycon.txt) | _ -> assert false @@ -182,6 +241,9 @@ let tyvar_visitor_method (alpha : tyvar) : methode = let datacon_descending_method (cd : constructor_declaration) : methode = X.visit_prefix ^ datacon_modified_name cd +let datacon_descending_method = + protect_datacon_descending_method datacon_descending_method + (* For every data constructor [datacon], there is a ascending visitor method, which is invoked on the way up, in order to re-build some data structure. This method is virtual and exists only when the scheme is [fold]. *) @@ -387,7 +449,7 @@ let ty_env = let tyvar_visitor_method_type = if X.poly "env" then - Typ.poly ["env"] (ty_arrow ty_env ty_any) + typ_poly ["env"] (ty_arrow ty_env ty_any) else ty_any @@ -538,7 +600,7 @@ let quantify (alphas : tyvars) (ty : core_type) : core_type = alphas in (* Done. *) - Typ.poly alphas ty + typ_poly alphas ty (* -------------------------------------------------------------------------- *) diff --git a/src/VisitorsAnalysis.ml b/src/VisitorsAnalysis.ml index 7d55357..39307e0 100644 --- a/src/VisitorsAnalysis.ml +++ b/src/VisitorsAnalysis.ml @@ -245,21 +245,18 @@ let rec occurs_type (alpha : tyvar) (ty : core_type) : unit = | Ptyp_constr (_, tys) | Ptyp_class (_, tys) -> occurs_types alpha tys - | Ptyp_object (methods, _) -> - List.iter (fun (_, _, ty) -> occurs_type alpha ty) methods + | Ptyp_object (fields, _) -> + let tys : core_type list = + List.map VisitorsCompatibility.object_field_to_core_type fields + in + List.iter (occurs_type alpha) tys | Ptyp_variant (fields, _, _) -> List.iter (occurs_row_field alpha) fields - | Ptyp_poly (_qs, ty) -> + | Ptyp_poly (qs, ty) -> + let qs : string list = VisitorsCompatibility.quantifiers qs in (* The type variables in [qs] are bound. *) - (* Unfortunately, the type of [qs] has changed from [string list] - to [string loc list] between OCaml 4.04 and 4.05. - See commit b0e880c448c78ed0cedff28356fcaf88f1436eef. - I do not want to do conditional compilation, - nor do I want to require 4.05 (yet). - So, for now, I just assume that [alpha] does not appear in [qs]. - This means that [occurs] can (on rare occasions) return [true] - when it should return [false]. *) - (* if not (occurs_quantifiers alpha qs) then *) occurs_type alpha ty + if not (occurs_quantifiers alpha qs) then + occurs_type alpha ty | Ptyp_package (_, ltys) -> List.iter (fun (_, ty) -> occurs_type alpha ty) ltys | Ptyp_extension (_, payload) -> @@ -275,8 +272,8 @@ and occurs_row_field alpha field = | Rinherit ty -> occurs_type alpha ty -and occurs_quantifiers alpha qs = - List.exists (fun q -> alpha = q.txt) qs +and occurs_quantifiers alpha (qs : string list) = + List.mem alpha qs and occurs_payload alpha = function | PTyp ty -> diff --git a/src/VisitorsCompatibility.cppo.ml b/src/VisitorsCompatibility.cppo.ml index 71b6b0f..4a55fc0 100644 --- a/src/VisitorsCompatibility.cppo.ml +++ b/src/VisitorsCompatibility.cppo.ml @@ -1,3 +1,4 @@ +let mknoloc = Location.mknoloc open Asttypes open Parsetree open Ast_helper @@ -68,3 +69,65 @@ let data_constructor_variety (cd : constructor_declaration) = | Pcstr_record lds -> DataInlineRecord (ld_labels lds, ld_tys lds) #endif + +(* 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 = + #if OCAML_VERSION < (4, 05, 0) + string + #else + string Location.loc + #endif + +let string2str (s : string) : str = + #if OCAML_VERSION < (4, 05, 0) + s + #else + mknoloc s + #endif + +let str2string (s : str) : string = + #if OCAML_VERSION < (4, 05, 0) + s + #else + s.txt + #endif + +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. *) + + +#if OCAML_VERSION < (4, 06, 0) +type object_field = + str * attributes * core_type +#endif + +let object_field_to_core_type : object_field -> core_type = + #if OCAML_VERSION < (4, 06, 0) + fun (_, _, ty) -> ty + #else + function + | Otag (_, _, ty) -> ty + | Oinherit ty -> ty + (* this may seem nonsensical, but (so far) is used only in the + function [occurs_type], where we do not care what the types + mean *) + #endif diff --git a/src/VisitorsGeneration.ml b/src/VisitorsGeneration.ml index 01fae98..2d656c2 100644 --- a/src/VisitorsGeneration.ml +++ b/src/VisitorsGeneration.ml @@ -467,7 +467,7 @@ let is_virtual (Meth (_, _, oe, _)) : bool = (* [send o m es] produces a call to the method [o#m] with arguments [es]. *) let send (o : variable) (m : methode) (es : expressions) : expression = - app (Exp.send (evar o) m) es + app (exp_send (evar o) m) es (* -------------------------------------------------------------------------- *) diff --git a/src/VisitorsString.ml b/src/VisitorsString.ml index 40e43e3..bf0d4a1 100644 --- a/src/VisitorsString.ml +++ b/src/VisitorsString.ml @@ -25,3 +25,46 @@ let unquote alpha = String.sub alpha 1 (n-1) else alpha + +(* [print_longident] converts an OCaml long identifier to a string. *) + +let print_longident (x : Longident.t) : string = + String.concat "." (Longident.flatten x) + +(* Suppose the function [f] is a lossy (non-injective) mapping of ['a] to + [string]. Then, the function [protect f equal warn] is also a function of + ['a] to [string], which behaves like [f], except it warns if [f] is applied + to two values of type ['a] that have the same image of type [string]. *) + +(* [equal] must implement equality at type ['a]. *) + +(* [warn x1 x2 y] is invoked when [f] is applied at two distinct values [x1] + and [x2] that have the same image [y] through [f]. Precautions are taken + so that [f] is not invoked repeatedly if the same conflict is repeatedly + detected. *) + +module H = Hashtbl + +let protect + (f : 'a -> string) + (equal : 'a -> 'a -> bool) + (warn : 'a -> 'a -> string -> unit) +: 'a -> string = + (* A hash table memoizes the inverse of [f]. *) + let table : (string, 'a list) H.t = H.create 127 in + fun (x : 'a) -> + let y = f x in + let xs = try H.find table y with Not_found -> [] in + H.add table y (x :: xs); + if List.exists (equal x) xs || xs = [] then + (* If the mapping of [x] to [y] is known already, + or if no pre-image of [y] was previously known, + then no warning is needed. *) + y + else + (* The list [xs] is nonempty and does not contain [x], + so its head [x'] is distinct from [x] and is also + a pre-image of [y]. Warn. *) + let x' = List.hd xs in + warn x' x y; + y diff --git a/test/bad/Makefile b/test/bad/Makefile new file mode 100644 index 0000000..6c8b7d4 --- /dev/null +++ b/test/bad/Makefile @@ -0,0 +1,7 @@ +.PHONY: test clean + +test: + cram -iv visitors.t + +clean: + rm -f visitors.t.err diff --git a/test/bad/conflict.ml b/test/bad/conflict.ml new file mode 100644 index 0000000..86b0186 --- /dev/null +++ b/test/bad/conflict.ml @@ -0,0 +1,25 @@ +module Elt = struct + type t = int +end + +type t = + | Leaf + | Node of { left: t; value: Elt.t; right: t } + [@@deriving visitors { variety = "iter" } ] + +(* + +Issue 3, reported by Gabriel Radanne. + +https://gitlab.inria.fr/fpottier/visitors/issues/3 + +File "conflict.ml", line 5, characters 0-111: +Error: This expression has type Elt.t = int + but an expression was expected of type t + +The naming convention for visitor methods causes a name clash: +the types [Elt.t] and [t] have visitor methods by the same name. + +A warning should be issued. + +*) diff --git a/test/bad/conflict_at_name.ml b/test/bad/conflict_at_name.ml new file mode 100644 index 0000000..ab67704 --- /dev/null +++ b/test/bad/conflict_at_name.ml @@ -0,0 +1,17 @@ +module Elt = struct + type elt = int +end + +type t = + | Leaf + | Node of { left: t; value: (Elt.elt[@name "t"]); right: t } + [@@deriving visitors { variety = "iter" } ] + +(* + +In this example, a stupid [@name] attribute causes a name clash: +the types [elt] and [t] have visitor methods by the same name. + +A warning should be issued. + +*) diff --git a/test/bad/conflict_atat_name.ml b/test/bad/conflict_atat_name.ml new file mode 100644 index 0000000..7acce5e --- /dev/null +++ b/test/bad/conflict_atat_name.ml @@ -0,0 +1,15 @@ +type t = + | Leaf + | Node of { left: t; value: elt; right: t } + [@@deriving visitors { variety = "iter" } ] + +and elt = int[@@name "t"] + +(* + +In this example, a stupid [@name] attribute causes a name clash: +the types [elt] and [t] have visitor methods by the same name. + +A warning should be issued. + +*) diff --git a/test/bad/datacon.ml b/test/bad/datacon.ml new file mode 100644 index 0000000..86c7c7f --- /dev/null +++ b/test/bad/datacon.ml @@ -0,0 +1,11 @@ +type t = + | A + | B of u + +and u = + | A of t + [@@deriving visitors { variety = "iter" }] + +(* Another example where two distinct types have a data constructor + named [A] (which OCaml warns about, but allows). This causes a + name clash on the methods [visit_A]. *) diff --git a/test/bad/datacon_at_name.ml b/test/bad/datacon_at_name.ml new file mode 100644 index 0000000..be3ce4a --- /dev/null +++ b/test/bad/datacon_at_name.ml @@ -0,0 +1,10 @@ +type t = + | A + | B of u + +and u = + | C of t [@name "A"] + [@@deriving visitors { variety = "iter" }] + +(* Another example where two distinct types have a data constructor + renamed [A]. This causes a name clash on the methods [visit_A]. *) diff --git a/test/bad/visitors.t b/test/bad/visitors.t new file mode 100644 index 0000000..9ffdba9 --- /dev/null +++ b/test/bad/visitors.t @@ -0,0 +1,49 @@ + + $ compile="ocamlfind ocamlc -c -package visitors.ppx -package visitors.runtime" + + $ $compile $TESTDIR/conflict.ml 2>&1 | sed -e "s|$TESTDIR/||" + File "conflict.ml", line 7, characters 30-35: + Warning 22: visitors: name clash: the types t and Elt.t + both have visitor methods named visit_t. + Please consider using [@@name] at type declaration sites + or [@name] at type reference sites. + File "conflict.ml", line 5, characters 0-111: + Error: This expression has type Elt.t = int + but an expression was expected of type t + + $ $compile $TESTDIR/conflict_at_name.ml 2>&1 | sed -e "s|$TESTDIR/||" + File "conflict_at_name.ml", line 7, characters 31-38: + Warning 22: visitors: name clash: the types t and Elt.elt + both have visitor methods named visit_t. + Please consider using [@@name] at type declaration sites + or [@name] at type reference sites. + File "conflict_at_name.ml", line 5, characters 0-126: + Error: This expression has type Elt.elt = int + but an expression was expected of type t + + $ $compile $TESTDIR/conflict_atat_name.ml 2>&1 | sed -e "s|$TESTDIR/||" + File "conflict_atat_name.ml", line 6, characters 0-25: + Warning 22: visitors: name clash: the types t and elt + both have visitor methods named visit_t. + Please consider using [@@name] at type declaration sites + or [@name] at type reference sites. + File "conflict_atat_name.ml", line 1, characters 0-136: + Error: The method `visit_t' has multiple definitions in this object + + $ $compile $TESTDIR/datacon.ml 2>&1 | sed -e "s|$TESTDIR/||" + File "datacon.ml", line 6, characters 2-10: + Warning 22: visitors: name clash: the data constructors A and A + both have visitor methods named visit_A. + Please consider using [@name] at data constructor declaration sites. + File "datacon.ml", line 6, characters 2-10: + Warning 30: the constructor A is defined in both types t and u. + File "datacon.ml", line 1, characters 0-90: + Error: The method `visit_A' has multiple definitions in this object + + $ $compile $TESTDIR/datacon_at_name.ml 2>&1 | sed -e "s|$TESTDIR/||" + File "datacon_at_name.ml", line 6, characters 2-22: + Warning 22: visitors: name clash: the data constructors A and C + both have visitor methods named visit_A. + Please consider using [@name] at data constructor declaration sites. + File "datacon_at_name.ml", line 1, characters 0-102: + Error: The method `visit_A' has multiple definitions in this object diff --git a/test/expr.mllib b/test/expr.mllib index 14d9c3d..b2f394d 100644 --- a/test/expr.mllib +++ b/test/expr.mllib @@ -5,6 +5,7 @@ expr00fold expr00fold2 expr01 expr01use +expr01use_variant expr02 expr03 expr04 diff --git a/test/expr01use.ml b/test/expr01use.ml index dd387bd..557e19c 100644 --- a/test/expr01use.ml +++ b/test/expr01use.ml @@ -22,3 +22,4 @@ let () = assert (optimize (z (EConst 1)) = EConst 1); assert (optimize (z (z (EConst 1))) = EConst 1); assert (optimize (EAdd (EConst 1, EConst 1)) = EAdd (EConst 1, EConst 1)); + assert (optimize (EAdd (z (EConst 1), EConst 1)) = EAdd (EConst 1, EConst 1)); diff --git a/test/expr01use.ml b/test/expr01use_variant.ml similarity index 57% copy from test/expr01use.ml copy to test/expr01use_variant.ml index dd387bd..42561f0 100644 --- a/test/expr01use.ml +++ b/test/expr01use_variant.ml @@ -1,18 +1,13 @@ open Expr01 -let add e1 e2 = - match e1, e2 with - | EConst 0, e - | e, EConst 0 -> e - | _, _ -> EAdd (e1, e2) - let optimize : expr -> expr = - let o = object (self) + let o = object(self) inherit [_] map method! visit_EAdd env e1 e2 = - add - (self#visit_expr env e1) - (self#visit_expr env e2) + match self#visit_expr env e1, self#visit_expr env e2 with + | EConst 0, e + | e, EConst 0 -> e + | e1, e2 -> EAdd (e1, e2) end in o # visit_expr () @@ -22,3 +17,4 @@ let () = assert (optimize (z (EConst 1)) = EConst 1); assert (optimize (z (z (EConst 1))) = EConst 1); assert (optimize (EAdd (EConst 1, EConst 1)) = EAdd (EConst 1, EConst 1)); + assert (optimize (EAdd (z (EConst 1), EConst 1)) = EAdd (EConst 1, EConst 1)); -- Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/ocaml-visitors.git _______________________________________________ Pkg-ocaml-maint-commits mailing list Pkg-ocaml-maint-commits@lists.alioth.debian.org http://lists.alioth.debian.org/cgi-bin/mailman/listinfo/pkg-ocaml-maint-commits