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
