[Pkg-ocaml-maint-commits] [ocaml-visitors] 01/03: New upstream version 20170725
Ralf Treinen
treinen at moszumanska.debian.org
Tue Jul 25 15:06:24 UTC 2017
This is an automated email from the git hooks/post-receive script.
treinen pushed a commit to branch master
in repository ocaml-visitors.
commit e88e214b9b5210fb21b69b7e792d1f5623013037
Author: Ralf Treinen <treinen at irif.fr>
Date: Tue Jul 25 16:50:13 2017 +0200
New upstream version 20170725
---
CHANGES | 55 ----------------
CHANGES.md | 79 +++++++++++++++++++++++
GNUmakefile | 5 +-
TODO | 18 +++++-
doc/english.bib | 167 ++++++++++++++++++++++++++++++++++++++++++++++--
doc/macros.tex | 3 +
doc/main.tex | 19 ++++++
src/Makefile | 23 +++++--
src/Visitors.ml | 25 +++++---
src/VisitorsAnalysis.ml | 8 +++
src/VisitorsSettings.ml | 39 ++++++++++-
test/expr.mllib | 1 +
test/expr01use.ml | 24 +++++++
test/misc.mllib | 1 +
test/prefixes.ml | 23 +++++++
15 files changed, 408 insertions(+), 82 deletions(-)
diff --git a/CHANGES b/CHANGES
deleted file mode 100644
index dfc40f9..0000000
--- a/CHANGES
+++ /dev/null
@@ -1,55 +0,0 @@
-2017/04/04:
-Extended backward compatibility to OCaml 4.02.2. (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
-is used in map, endo, and mapreduce visitors. See the documentation for
-details. (This feature was suggested by Reuben Rowe.)
-
-2017/03/15:
-New attributes [@name] and [@@name] can be attached to types, type declarations,
-and data constructors, so as to alter the names of the generated methods. See
-the documentation for details. (This feature was suggested by Reuben Rowe.)
-
-2017/03/08:
-A new option [polymorphic = true] allows generating visitor methods with
-polymorphic types. With [polymorphic = true], a type variable ['a] is
-handled by a visitor *function* [visit_'a], which is passed as an argument
-to every visitor method; whereas, with [polymorphic = false], a type
-variable ['a] is handled by a virtual visitor *method* [visit_'a].
-With [polymorphic = true], visitor classes compose better,
-and irregular algebraic data types are supported.
-See the documentation for more details.
-(This feature was suggested by Reuben Rowe.)
-
-2017/03/03:
-A new option [data = false] allows suppressing the generation of visitor
-methods for data constructors. This makes the generated visitor slightly
-simpler and faster, but less customizable.
-
-A new option [nude = true] allows *not* implicitly inheriting the class
-VisitorsRuntime.<variety>.
-
-2017/02/15:
-Makefile.preprocess is now installed with the package, so users can rely on it
-without needing to copy it. See the documentation for instructions.
-
-2017/02/13:
-Added a new variety of visitors, "mapreduce". This visitor computes a pair of a
-data structure (like a "map" visitor) and a summary (like a "reduce" visitor).
-This can be used to annotate every tree node with information about the
-subtree that lies below it. See the documentation for an example.
-
-2017/02/09:
-Documentation: added a new subsection on OCaml objects,
-entitled "Where the expressiveness of OCaml's type system falls short".
-This section explains why "map" cannot be a subclass of "fold",
-even though it should be.
-
-2017/01/31:
-Documentation: added an example of constructing a lexicographic ordering.
-Documentation: discussed generating visitors for existing types and ppx_import.
-
-2017/01/26:
-Initial release.
diff --git a/CHANGES.md b/CHANGES.md
new file mode 100644
index 0000000..eea14f5
--- /dev/null
+++ b/CHANGES.md
@@ -0,0 +1,79 @@
+# Changes
+
+## 2017/07/25
+
+* Updated `src/Makefile` to allow compilation on systems where `ocamlopt` is
+ missing. (Suggested by Ralf Treinen.)
+
+## 2017/04/20
+
+* New settings `visit_prefix`, `build_prefix`, and `fail_prefix` can be used
+ to control which prefixes are used in generated method names. (This feature
+ was suggested by Philip Hölzenspies.)
+
+## 2017/04/04
+
+* Extended backward compatibility to OCaml 4.02.2. (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
+ is used in `map`, `endo`, and `mapreduce` visitors. See the documentation for
+ details. (This feature was suggested by Reuben Rowe.)
+
+## 2017/03/15
+
+* New attributes `@name` and `@@name` can be attached to types, type declarations,
+ and data constructors, so as to alter the names of the generated methods. See
+ the documentation for details. (This feature was suggested by Reuben Rowe.)
+
+## 2017/03/08
+
+* A new option `polymorphic = true` allows generating visitor methods with
+ polymorphic types. With `polymorphic = true`, a type variable `'a` is
+ handled by a visitor *function* `visit_'a`, which is passed as an argument
+ to every visitor method; whereas, with `polymorphic = false`, a type
+ variable `'a` is handled by a virtual visitor *method* `visit_'a`.
+ With `polymorphic = true`, visitor classes compose better,
+ and irregular algebraic data types are supported.
+ See the documentation for more details.
+ (This feature was suggested by Reuben Rowe.)
+
+## 2017/03/03
+
+* A new option `data = false` allows suppressing the generation of visitor
+ methods for data constructors. This makes the generated visitor slightly
+ simpler and faster, but less customizable.
+
+* A new option `nude = true` allows *not* implicitly inheriting the class
+ `VisitorsRuntime.<variety>`.
+
+## 2017/02/15
+
+* `Makefile.preprocess` is now installed with the package, so users can rely on it
+ without needing to copy it. See the documentation for instructions.
+
+## 2017/02/13
+
+* Added a new variety of visitors, `mapreduce`. This visitor computes a pair of a
+ data structure (like a `map` visitor) and a summary (like a `reduce` visitor).
+ This can be used to annotate every tree node with information about the
+ subtree that lies below it. See the documentation for an example.
+
+## 2017/02/09
+
+* Documentation: added a new subsection on OCaml objects,
+ entitled "Where the expressiveness of OCaml's type system falls short".
+ This section explains why `map` cannot be a subclass of `fold`,
+ even though it should be.
+
+## 2017/01/31
+
+* Documentation: added an example of constructing a lexicographic ordering.
+
+* Documentation: discussed generating visitors for existing types and `ppx_import`.
+
+## 2017/01/26
+
+* Initial release.
diff --git a/GNUmakefile b/GNUmakefile
index 3a63d3b..b2e3c38 100644
--- a/GNUmakefile
+++ b/GNUmakefile
@@ -15,7 +15,8 @@ include Makefile
# Utilities.
-MD5SUM := $(shell if command -v md5 2>/dev/null ; then echo "md5 -r" ; else echo md5sum ; fi)
+MD5SUM := $(shell if command -v md5 >/dev/null 2>/dev/null ; \
+ then echo "md5 -r" ; else echo md5sum ; fi)
# -------------------------------------------------------------------------
@@ -36,7 +37,7 @@ TARBALL := $(CURRENT)/$(PACKAGE).tar.gz
# This does not include the src/ and doc/ directories, which require
# special treatment.
-DISTRIBUTED_FILES := AUTHORS CHANGES LICENSE Makefile
+DISTRIBUTED_FILES := AUTHORS CHANGES.md LICENSE Makefile
# -------------------------------------------------------------------------
diff --git a/TODO b/TODO
index 9e3b1d3..e320c0b 100644
--- a/TODO
+++ b/TODO
@@ -46,7 +46,15 @@ Once we have that, can we deal with GADTs?
In [fold],
the build_ methods could take not only the results of the recursive calls,
- but also their arguments (for added expressive power).
+ but also their arguments (for added expressive power). That would be a
+ true "recursor" (David Chemouil).
+
+Could we have visitors where a state is explicitly threaded from left to right?
+ (David Chemouil.)
+For greater generality, maybe we should have monadic visitors.
+Currently, the environment monad (a reader monad) is built-in.
+Could we let the user choose which monad should be used,
+ without breaking compatibility?
Develop a real test suite, with expected output.
Check for left-to-right traversal order.
@@ -69,6 +77,14 @@ Could define a fold visitor where the methods receive the names of the types,
data constructors, and record fields that are being visited. (As in
ppx_tools/genlifter.)
+Develop [@deriving zippers] to produce a type of zippers,
+ and add an option for the environment to be a zipper
+ that is extended at every recursive call. (Yann Régis-Gianas.)
+ Parameterize the type of zippers by the type of their root
+ and allow the constructor Nil only when the root type and
+ the current type coincide. (GADT.)
+ So that we get n zipper types out of n source types.
+
Avoid generating beta-redexes.
(fun (x, y) -> ...) z should be let (x, y) = z in ...
See [visit_types].
diff --git a/doc/english.bib b/doc/english.bib
index 62e8942..1d5f136 100644
--- a/doc/english.bib
+++ b/doc/english.bib
@@ -193,6 +193,8 @@
@String{jfp = "Journal of Functional Programming"}
+ at String{jfr = "Journal of Formalized Reasoning"}
+
@String{jlap = "Journal of Logic and Algebraic Programming"}
@String{jlc = "Journal of Logic and Computation"}
@@ -379,6 +381,9 @@
@String{tose = "IEEE Transactions on Software Engineering"}
+ at String{tosem = "ACM Transactions on Software Engineering and
+ Methodology"}
+
@String{tphol = "Theorem Proving in Higher Order Logics (TPHOLs)"}
@String{types = "Types for Proofs and Programs"}
@@ -838,6 +843,16 @@
URL = "http://www.cs.cornell.edu/talc/papers/alias.pdf",
}
+ at InProceedings{allais-cpp-17,
+ author = "Guillaume Allais and James Chapman and Conor McBride
+ and James McKinna",
+ title = "Type-and-scope Safe Programs and Their Proofs",
+ booktitle = cpp,
+ pages = "195--207",
+ year = "2017",
+ URL = "http://gallais.github.io/pdf/cpp2017.pdf",
+}
+
@InProceedings{almeida-97,
author = "Paulo S{\'e}rgio Almeida",
title = "Balloon Types: Controlling Sharing of State in Data
@@ -1311,7 +1326,6 @@
series = lncs,
volume = "9236",
publisher = springer,
- year = "2015",
URL = "https://www.ps.uni-saarland.de/Publications/documents/SchaeferEtAl_2015_Autosubst_-Reasoning.pdf",
}
@@ -1571,6 +1585,20 @@
URL = "http://www.csl.sri.com/users/ruess/papers/Fixpoints/fixpoints-domains3.ps.gz",
}
+ at InProceedings{barthe-06,
+ author = "Gilles Barthe and Julien Forest and David Pichardie
+ and Vlad Rusu",
+ title = "Defining and Reasoning About Recursive Functions: A
+ Practical Tool for the {Coq} Proof Assistant",
+ booktitle = flops,
+ pages = "114--129",
+ year = "2006",
+ series = lncs,
+ volume = "3945",
+ publisher = springer,
+ URL = "http://people.irisa.fr/David.Pichardie/papers/flops06.pdf",
+}
+
@InProceedings{barthwal-norrish-09,
author = "Aditi Barthwal and Michael Norrish",
title = "Verified, Executable Parsing",
@@ -1616,6 +1644,32 @@
URL = "http://www.cs.fit.edu/~ryan/papers/explain.ps.gz",
}
+ at InProceedings{belanger-monnier-pientka-13,
+ author = "Olivier {Savary Belanger} and Stefan Monnier and
+ Brigitte Pientka",
+ title = "Programming Type-Safe Transformations Using
+ Higher-Order Abstract Syntax",
+ booktitle = cpp,
+ pages = "243--258",
+ year = "2013",
+ series = lncs,
+ volume = "8307",
+ publisher = springer,
+ URL = "https://link.springer.com/chapter/10.1007/978-3-319-03545-1_16",
+}
+
+ at Article{belanger-monnier-pientka-15,
+ author = "Olivier {Savary Belanger} and Stefan Monnier and
+ Brigitte Pientka",
+ title = "Programming Type-Safe Transformations Using
+ Higher-Order Abstract Syntax",
+ journal = jfr,
+ year = "2015",
+ volume = "8",
+ number = "1",
+ URL = "https://jfr.unibo.it/article/view/5122/5330",
+}
+
@InProceedings{bell-08,
author = "C. J. Bell and Robert Dockins and Aquinas Hobor and
Andrew W. Appel and David Walker",
@@ -3854,6 +3908,16 @@
URL = "http://www.cs.cmu.edu/~crary/papers/1998/thesis/thesis.ps.gz",
}
+ at TechReport{crary-standard-09,
+ author = "Karl Crary",
+ title = "A Simple Proof of Call-by-Value Standardization",
+ institution = "Carnegie Mellon University",
+ year = "2009",
+ type = "Technical Report",
+ number = "CMU-CS-09-137",
+ URL = "https://www.cs.cmu.edu/~crary/papers/2009/standard.pdf",
+}
+
@InProceedings{crary-weirich-00,
author = "Karl Crary and Stephanie Weirich",
title = "Resource bound certification",
@@ -4009,6 +4073,17 @@
URL = "http://www.brics.dk/RS/01/23/",
}
+ at Article{danvy-nielsen-03,
+ author = "Olivier Danvy and Lasse R. Nielsen",
+ title = "A first-order one-pass {CPS} transformation",
+ journal = tcs,
+ volume = "308",
+ number = "1--3",
+ pages = "239--257",
+ year = "2003",
+ URL = "http://dx.doi.org/10.1016/S0304-3975(02)00733-8",
+}
+
@InProceedings{danvy-nielsen-ppdp-01,
author = "Olivier Danvy and Lasse R. Nielsen",
title = "Defunctionalization at Work",
@@ -4038,6 +4113,18 @@
URL = "http://www.univ-orleans.fr/SCIENCES/LIFO/Members/dao/papers/ts4dec.ps.gz",
}
+ at InProceedings{dargaye-leroy-cps-07,
+ author = "Zaynah Dargaye and Xavier Leroy",
+ title = "Mechanized verification of {CPS} transformations",
+ booktitle = lpar,
+ year = "2007",
+ series = lnai,
+ volume = "4790",
+ publisher = springer,
+ pages = "211--225",
+ URL = "http://gallium.inria.fr/~xleroy/publi/cps-dargaye-leroy.pdf",
+}
+
@TechReport{davies-05,
author = "Rowan Davies",
title = "Practical Refinement-Type Checking",
@@ -4611,6 +4698,18 @@
URL = "http://www.cs.indiana.edu/~dyb/pubs/LaSC-5-4-pp295-326.pdf",
}
+ at Article{eberl-17,
+ author = "Manuel Eberl",
+ title = "Proving Divide and Conquer Complexities in
+ {Isabelle/HOL}",
+ journal = jar,
+ volume = "58",
+ number = "4",
+ pages = "483--508",
+ year = "2017",
+ URL = "https://www21.in.tum.de/~eberlm/divide_and_conquer_isabelle.pdf",
+}
+
@InProceedings{eifrig-smith-trifonov-94,
author = "Jonathan Eifrig and Scott Smith and Valery Trifonov",
title = "Type Inference for Recursively Constrained Types and
@@ -6402,7 +6501,7 @@
volume = "2741",
series = lncs,
publisher = springer,
- URL = "http://www.cs.ru.nl/~hendriks/publication/ps/adbmal_cade.ps",
+ URL = "http://www.phil.uu.nl/~oostrom/publication/ps/adbmal_jfpsv.ps",
}
@InProceedings{henglein-91,
@@ -7062,6 +7161,18 @@
URL = "http://yquem.inria.fr/~huet/PUBLIC/zip.pdf",
}
+ at InProceedings{huffman-urban-10,
+ author = "Brian Huffman and Christian Urban",
+ title = "A New Foundation for {Nominal Isabelle}",
+ booktitle = itp,
+ pages = "35--50",
+ year = "2010",
+ series = lncs,
+ volume = "6172",
+ publisher = springer,
+ URL = "http://nms.kcl.ac.uk/christian.urban/Publications/nominal-atoms.pdf",
+}
+
@Article{hughes-arrows-00,
author = "John Hughes",
title = "Generalising monads to arrows",
@@ -7885,6 +7996,17 @@
URL = "http://ertos.nicta.com.au/publications/papers/Klein_EHACDEEKNSTW_10.pdf",
}
+ at Article{klint-laemmel-verhoef-05,
+ author = "Paul Klint and Ralf L{\"a}mmel and Chris Verhoef",
+ title = "{Toward an engineering discipline for grammarware}",
+ journal = tosem,
+ volume = "14",
+ number = "3",
+ year = "2005",
+ pages = "331--380",
+ URL = "http://www.few.vu.nl/~x/gw/gw.pdf",
+}
+
@InProceedings{kloos-majumdar-vafeiadis-15,
author = "Johannes Kloos and Rupak Majumdar and Viktor
Vafeiadis",
@@ -9372,6 +9494,14 @@
URL = "http://www.cs.cornell.edu/Info/People/jgm/papers/closure-summary.ps",
}
+ at InProceedings{minamide-okuma-03,
+ author = "Yasuhiko Minamide and Koji Okuma",
+ title = "Verifying {CPS} transformations in {Isabelle/HOL}",
+ booktitle = merlin,
+ year = "2003",
+ URL = "http://doi.acm.org/10.1145/976571.976576",
+}
+
@Article{mitchell-05,
author = "David G. Mitchell",
title = "A {SAT} Solver Primer",
@@ -9763,8 +9893,7 @@
author = "Andrew C. Myers and Barbara Liskov",
title = "Protecting Privacy using the Decentralized Label
Model",
- journal = "ACM Transactions on Software Engineering and
- Methodology",
+ journal = tosem,
volume = "9",
number = "4",
year = "2000",
@@ -10997,6 +11126,18 @@
URL = "http://www.cs.cmu.edu/~aldrich/papers/plaid-NIER2010.pdf",
}
+ at Article{plotkin-75,
+ author = "Gordon D. Plotkin",
+ title = "Call-by-name, call-by-value and the
+ $\lambda$-calculus",
+ journal = tcs,
+ volume = "1",
+ number = "2",
+ pages = "125--159",
+ year = "1975",
+ URL = "http://homepages.inf.ed.ac.uk/gdp/publications/cbn_cbv_lambda.pdf",
+}
+
@InCollection{plotkin-90,
author = "Gordon Plotkin",
title = "An illative theory of relations",
@@ -13587,6 +13728,19 @@
URL = "http://www.informatik.uni-freiburg.de/~thiemann/papers/clapf99.ps.gz",
}
+ at InProceedings{tian-06,
+ author = "Ye Henry Tian",
+ title = "Mechanically Verifying Correctness of {CPS}
+ Compilation",
+ booktitle = "Computing: The Australasian Theory Symposium (CATS)",
+ pages = "41--51",
+ year = "2006",
+ URL = "http://crpit.com/confpapers/CRPITV51Tian.pdf",
+ series = "{CRPIT}",
+ volume = "51",
+ publisher = "Australian Computer Society",
+}
+
@InProceedings{tiuryn-92,
author = "Jerzy Tiuryn",
title = "Subtype inequalities",
@@ -13816,8 +13970,8 @@
journal = jar,
volume = "40",
number = "4",
- year = "2008",
pages = "327--356",
+ year = "2008",
URL = "https://nms.kcl.ac.uk/christian.urban/Publications/nom-tech.pdf",
}
@@ -14215,8 +14369,7 @@
Felten",
title = "Safkasi: {A} Security Mechanism for Language-based
Systems",
- journal = "ACM Transactions on Software Engineering and
- Methodology",
+ journal = tosem,
year = "2000",
volume = "9",
number = "4",
diff --git a/doc/macros.tex b/doc/macros.tex
index 7faa2b4..b1c0118 100644
--- a/doc/macros.tex
+++ b/doc/macros.tex
@@ -118,3 +118,6 @@
\newcommand{\data}{\texttt{data}\xspace}
\newcommand{\nude}{\texttt{nude}\xspace}
\newcommand{\polymorphic}{\texttt{polymorphic}\xspace}
+\newcommand{\visitprefix}{\texttt{visit\_prefix}\xspace}
+\newcommand{\buildprefix}{\texttt{build\_prefix}\xspace}
+\newcommand{\failprefix}{\texttt{fail\_prefix}\xspace}
diff --git a/doc/main.tex b/doc/main.tex
index d6cbf69..eaacde6 100644
--- a/doc/main.tex
+++ b/doc/main.tex
@@ -583,6 +583,9 @@ due to restrictions imposed by OCaml's type discipline (\sref{sec:map_from_fold}
% - and there are fewer visitor methods, basically one per type,
% plus one primitive type, plus this#record, this#constr.
+% TEMPORARY show how to do a fold in the presence of primitive types, e.g., list
+% writing ancestors = ["VisitorsRuntime.map"] may be necessary
+
% ------------------------------------------------------------------------------
\begin{figure}[p]
@@ -1791,6 +1794,11 @@ programming languages, but also in an object-oriented programming setting.
Every ancestor class must have exactly \emph{one} type parameter,
which is typically (but not necessarily) the type of ``self''.
\\
+ \buildprefix & (string) &
+ The prefix that is used in the name of the build methods in \fold and
+ \foldtwo visitors (\sref{sec:intro:fold}).
+ This is an optional parameter, whose default value is ``\texttt{build\_}''.
+\\
\concrete & (Boolean) &
If \texttt{true}, the generated class is declared
concrete; otherwise, it is declared virtual.
@@ -1801,6 +1809,11 @@ programming languages, but also in an object-oriented programming setting.
If \texttt{false}, this method is not generated (it is inlined instead).
This is an optional parameter; its default value is \texttt{true}.
\\
+ \failprefix & (string) &
+ The prefix that is used in the name of the failure methods in
+ visitors of arity two (\sref{sec:intro:aritytwo}).
+ This is an optional parameter, whose default value is ``\texttt{fail\_}''.
+\\
\irregular & (Boolean) &
If \texttt{true}, the regularity check (\sref{sec:regularity}) is disabled;
otherwise, it is enabled.
@@ -1845,6 +1858,12 @@ programming languages, but also in an object-oriented programming setting.
\mapreducetwo,
\foldtwo (\sref{sec:intro:aritytwo}).
\\
+ \visitprefix & (string) &
+ The prefix that is used in the name of visitor methods.
+ This is an optional parameter, whose default value is ``\texttt{visit\_}''.
+ Be aware that, if this prefix is changed, then the classes provided by the
+ library \texttt{VisitorsRuntime} become useless: in that case, one might wish to
+ also specify \verb+nude = true+, so as to not inherit these classes.
\end{tabular}
\vspace{2.5mm}
\hrule
diff --git a/src/Makefile b/src/Makefile
index 91e6db9..3b20dc2 100644
--- a/src/Makefile
+++ b/src/Makefile
@@ -17,17 +17,29 @@ OCAMLBUILD := \
-classic-display \
-plugin-tag 'package(cppo_ocamlbuild)' \
+# Detect whether ocamlopt is available.
+NATIVE := $(shell if env ocamlopt >/dev/null 2>/dev/null ; then \
+ echo yes ; else echo no ; fi)
+
# The targets that should be built (using ocamlbuild).
# Not sure whether all of the following files are really required.
-TARGET := \
- $(patsubst %,$(PLUGIN).%,a cma cmxa cmxs) \
- $(patsubst %,$(RUNTIME).%,a cma cmi cmo cmx cmxa o) \
+ifeq ($(NATIVE),yes)
+ MSG := "Compiling for byte code and native code."
+ TARGETS := \
+ $(patsubst %,$(PLUGIN).%,cma a cmxa cmxs) \
+ $(patsubst %,$(RUNTIME).%,cmi cmo cma a cmx cmxa o)
+else
+ MSG := "Compiling for byte code only."
+ TARGETS := \
+ $(patsubst %,$(PLUGIN).%,cma) \
+ $(patsubst %,$(RUNTIME).%,cmi cmo cma)
+endif
# The files that should be installed (using ocamlfind).
FILES := \
META \
Makefile.preprocess \
- $(patsubst %,_build/%,$(TARGET)) \
+ $(patsubst %,_build/%,$(TARGETS)) \
# ------------------------------------------------------------------------------
@@ -36,7 +48,8 @@ FILES := \
.PHONY: all clean install uninstall reinstall
all:
- $(OCAMLBUILD) $(TARGET)
+ @ echo $(MSG)
+ $(OCAMLBUILD) $(TARGETS)
clean:
rm -f *~
diff --git a/src/Visitors.ml b/src/Visitors.ml
index 64c21fc..0ad37aa 100644
--- a/src/Visitors.ml
+++ b/src/Visitors.ml
@@ -118,10 +118,15 @@ let check_regularity loc tycon (formals : tyvars) (actuals : core_types) =
(* Public naming conventions. *)
(* The names of the methods associated with the type [foo] are normally based
- on (derived from) the name [foo]. This base name can be overriden by the
- user via an attribute. For a local type, a [@@name] attribute must be
- attached to the type declaration. For a nonlocal type, a [@name] attribute
- must be attached to every reference to this type. *)
+ on (derived from) the name [foo].
+
+ This base name can be overriden by the user via an attribute. For a local
+ type, a [@@name] attribute must be attached to the type declaration. For a
+ nonlocal type, a [@name] attribute must be attached to every reference to
+ this type.
+
+ The prefix that is prepended to the base name can be controlled via the
+ settings [visit_prefix], [build_prefix], and [fail_prefix]. *)
let tycon_modified_name (attrs : attributes) (tycon : tycon) : tycon =
maybe (name attrs) tycon
@@ -140,7 +145,7 @@ let datacon_modified_name (cd : constructor_declaration) : datacon =
or [A.foo]. (A qualified name must denote a nonlocal type.) *)
let tycon_visitor_method (attrs : attributes) (tycon : tycon) : methode =
- "visit_" ^ tycon_modified_name attrs tycon
+ X.visit_prefix ^ tycon_modified_name attrs tycon
let local_tycon_visitor_method (decl : type_declaration) : methode =
tycon_visitor_method decl.ptype_attributes decl.ptype_name.txt
@@ -160,13 +165,13 @@ let nonlocal_tycon_visitor_method (ty : core_type) : methode =
(* The name of this method is normally [build_foo] if the type is named [foo]. *)
let tycon_ascending_method (decl : type_declaration) : methode =
- "build_" ^ tycon_modified_name decl.ptype_attributes decl.ptype_name.txt
+ X.build_prefix ^ tycon_modified_name decl.ptype_attributes decl.ptype_name.txt
(* [mono] type variables have a virtual visitor method. We include a quote in
the method name so as to ensure the absence of collisions. *)
let tyvar_visitor_method (alpha : tyvar) : methode =
- "visit_'" ^ alpha
+ sprintf "%s'%s" X.visit_prefix alpha
(* For every data constructor [datacon], there is a descending visitor method,
which is invoked on the way down, when this data constructor is discovered. *)
@@ -175,14 +180,14 @@ let tyvar_visitor_method (alpha : tyvar) : methode =
named [Foo]. *)
let datacon_descending_method (cd : constructor_declaration) : methode =
- "visit_" ^ datacon_modified_name cd
+ X.visit_prefix ^ datacon_modified_name cd
(* 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]. *)
let datacon_ascending_method (cd : constructor_declaration) : methode =
- "build_" ^ datacon_modified_name cd
+ X.build_prefix ^ datacon_modified_name cd
(* At arity 2, for every sum type constructor [tycon] which has at least two
data constructors, there is a failure method, which is invoked when the
@@ -191,7 +196,7 @@ let datacon_ascending_method (cd : constructor_declaration) : methode =
(* The name of this method is normally [fail_foo] if the type is named [foo]. *)
let failure_method (decl : type_declaration) : methode =
- "fail_" ^ tycon_modified_name decl.ptype_attributes decl.ptype_name.txt
+ X.fail_prefix ^ tycon_modified_name decl.ptype_attributes decl.ptype_name.txt
(* When [scheme] is [Reduce], we need a monoid, that is, a unit [zero] and a
binary operation [plus]. The names [zero] and [plus] are fixed. We assume
diff --git a/src/VisitorsAnalysis.ml b/src/VisitorsAnalysis.ml
index 5d46aa0..7d55357 100644
--- a/src/VisitorsAnalysis.ml
+++ b/src/VisitorsAnalysis.ml
@@ -87,6 +87,14 @@ let is_valid_class_longident (m : string) : bool =
(* -------------------------------------------------------------------------- *)
+(* Testing if a string is a valid method name prefix. *)
+
+let is_valid_method_name_prefix (m : string) : bool =
+ String.length m > 0 &&
+ classify m = LIDENT
+
+(* -------------------------------------------------------------------------- *)
+
(* Testing for the presence of attributes. *)
(* We use [ppx_deriving] to extract a specific attribute from an attribute
diff --git a/src/VisitorsSettings.ml b/src/VisitorsSettings.ml
index e000a3c..d10b221 100644
--- a/src/VisitorsSettings.ml
+++ b/src/VisitorsSettings.ml
@@ -50,6 +50,21 @@ module type SETTINGS = sig
the string provided by the user. *)
val variety: string
+ (* [visit_prefix] is the common prefix used to name the descending visitor
+ methods. It must be nonempty and a valid identifier by itself. Its
+ default value is "visit_". *)
+ val visit_prefix: string
+
+ (* [build_prefix] is the common prefix used to name the ascending visitor
+ methods. It must be nonempty and a valid identifier by itself. Its
+ default value is "build_". *)
+ val build_prefix: string
+
+ (* [fail_prefix] is the common prefix used to name the failure methods. It
+ must be nonempty and a valid identifier by itself. Its default value is
+ "fail_". *)
+ val fail_prefix: string
+
(* The classes that the visitor should inherit. If [nude] is [false], the
class [VisitorsRuntime.<scheme>] is implicitly prepended to this list.
If [nude] is [true], it is not. *)
@@ -141,15 +156,20 @@ let parse_variety loc (s : string) : scheme * int =
(* -------------------------------------------------------------------------- *)
+let must_be_valid_method_name_prefix loc p =
+ if not (is_valid_method_name_prefix p) then
+ raise_errorf ~loc
+ "%s: %S is not a valid method name prefix." plugin p
+
let must_be_valid_mod_longident loc m =
if not (is_valid_mod_longident m) then
raise_errorf ~loc
- "%s: %s is not a valid module identifier." plugin m
+ "%s: %S is not a valid module identifier." plugin m
let must_be_valid_class_longident loc c =
if not (is_valid_class_longident c) then
raise_errorf ~loc
- "%s: %s is not a valid class identifier." plugin c
+ "%s: %S is not a valid class identifier." plugin c
(* -------------------------------------------------------------------------- *)
@@ -195,6 +215,9 @@ end)
let arity = ref 1 (* dummy: [variety] is mandatory; see below *)
let scheme = ref Iter (* dummy: [variety] is mandatory; see below *)
let variety = ref None
+ let visit_prefix = ref "visit_"
+ let build_prefix = ref "build_"
+ let fail_prefix = ref "fail_"
let ancestors = ref []
let concrete = ref false
let data = ref true
@@ -210,6 +233,15 @@ end)
iter (fun (o, e) ->
let loc = e.pexp_loc in
match o with
+ | "visit_prefix" ->
+ visit_prefix := string e;
+ must_be_valid_method_name_prefix loc !visit_prefix
+ | "build_prefix" ->
+ build_prefix := string e;
+ must_be_valid_method_name_prefix loc !build_prefix
+ | "fail_prefix" ->
+ fail_prefix := string e;
+ must_be_valid_method_name_prefix loc !fail_prefix
| "ancestors" ->
ancestors := strings e
| "concrete" ->
@@ -275,6 +307,9 @@ end)
let decls = decls
let arity = !arity
let scheme = !scheme
+ let visit_prefix = !visit_prefix
+ let build_prefix = !build_prefix
+ let fail_prefix = !fail_prefix
let ancestors = !ancestors
let concrete = !concrete
let data = !data
diff --git a/test/expr.mllib b/test/expr.mllib
index ccd6b8b..14d9c3d 100644
--- a/test/expr.mllib
+++ b/test/expr.mllib
@@ -4,6 +4,7 @@ expr00endo
expr00fold
expr00fold2
expr01
+expr01use
expr02
expr03
expr04
diff --git a/test/expr01use.ml b/test/expr01use.ml
new file mode 100644
index 0000000..dd387bd
--- /dev/null
+++ b/test/expr01use.ml
@@ -0,0 +1,24 @@
+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)
+ inherit [_] map
+ method! visit_EAdd env e1 e2 =
+ add
+ (self#visit_expr env e1)
+ (self#visit_expr env e2)
+ end in
+ o # visit_expr ()
+
+let z e = EAdd (e, EConst 0)
+
+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));
diff --git a/test/misc.mllib b/test/misc.mllib
index 35014fa..3e96dad 100644
--- a/test/misc.mllib
+++ b/test/misc.mllib
@@ -10,6 +10,7 @@ monopoly
opaque
point
polyclass
+prefixes
test00
test01
test02
diff --git a/test/prefixes.ml b/test/prefixes.ml
new file mode 100644
index 0000000..5705855
--- /dev/null
+++ b/test/prefixes.ml
@@ -0,0 +1,23 @@
+class ['self] base = object(_ : 'self)
+ method on_int () i j = i + j
+end
+
+type inttree = Node of (int * inttree * inttree) | Leaf of int
+[@@deriving visitors { variety = "fold2"; visit_prefix = "on_";
+ build_prefix = "mk_"; fail_prefix = "err_";
+ nude = true; ancestors = ["base"]}]
+
+let add_inttree : inttree -> inttree -> int =
+ let v = object
+ inherit [_] fold2 as super
+ method mk_Node () (i, l, r) = i + l + r
+ method mk_Leaf () i = i
+ method! err_inttree () _l _r = 0
+ method! on_inttree = super # on_inttree
+ end
+ in v # on_inttree ()
+
+let t = Node (1, Leaf 2, Leaf 3)
+
+let (_i : int) =
+ add_inttree t t
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-ocaml-maint/packages/ocaml-visitors.git
More information about the Pkg-ocaml-maint-commits
mailing list