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 <trei...@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"} +@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"} +@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", } +@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", } +@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", } +@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", +} + +@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", } +@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/", } +@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", } +@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", } +@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", } +@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", } +@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", } +@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", } +@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", } +@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 _______________________________________________ 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