Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

patterns 0.4

  • Loading branch information...
commit f5fad7521486d4e4ad5c5efcf24c71faebdc64b2 0 parents
Jake Donham authored
Showing with 3,621 additions and 0 deletions.
  1. +53 −0 CHANGES
  2. +20 −0 COPYING
  3. +8 −0 Makefile
  4. +1,239 −0 OCamlMakefile
  5. +34 −0 README
  6. +5 −0 VERSION
  7. +11 −0 applications/Makefile
  8. +17 −0 applications/Makefile.application
  9. +14 −0 applications/README
  10. +3 −0  applications/combination/Makefile
  11. +34 −0 applications/combination/combination_tests.ml
  12. +4 −0 applications/conjunctive/Makefile
  13. +25 −0 applications/conjunctive/conjunctive_tests.ml
  14. +15 −0 applications/conjunctive/pa_conjunctive.ml
  15. +4 −0 applications/lazy/Makefile
  16. +201 −0 applications/lazy/lazy_tests.ml
  17. +159 −0 applications/lazy/lazy_tests_revised.ml
  18. +22 −0 applications/lazy/pa_lazy.ml
  19. +4 −0 applications/n+k/Makefile
  20. +81 −0 applications/n+k/nplusk_tests.ml
  21. +17 −0 applications/n+k/pa_nplusk.ml
  22. +4 −0 applications/negative/Makefile
  23. +83 −0 applications/negative/negative_tests.ml
  24. +15 −0 applications/negative/pa_negative.ml
  25. +4 −0 applications/object/Makefile
  26. +91 −0 applications/object/object_tests.ml
  27. +44 −0 applications/object/pa_object.ml
  28. +452 −0 patterns.ml
  29. +918 −0 traverse.ml
  30. +40 −0 traverse.mli
53 CHANGES
@@ -0,0 +1,53 @@
+0.4
+
+Changes from 0.3
+
+ * Patterns is now packaged as a library that makes it easy to extend
+ pattern matching. Lazy patterns are still available, but as an
+ application of the library rather than as a hard-coded extension.
+
+ * Pattern guards are gone for now. The intention is to restore them
+ in a future release, as an optional package implemented as an
+ application of the library rather than a hardcoded extension.
+
+ * Patterns should now coexist more happily with other extensions.
+
+ * Lots of examples, e.g. an implementation of conjunctive patterns.
+ See the `applications' directory.
+
+ * Everything now works with both original and revised.
+
+ * A number of bug fixes and a more robust, completely functional,
+ implementation.
+
+ * The MIT License is included in the source tarball. (This is just
+ a packaging change, not a change of license.)
+
+------------------------------------------------------------------------------
+0.3
+
+Changes from 0.2:
+
+ * Lazy patterns
+
+------------------------------------------------------------------------------
+0.2
+
+Changes from 0.1:
+
+ * A new design for pattern guards which allows with-bindings within
+ top-level or-patterns (see the documentation)
+
+ * Fewer warnings in generated code: patterns that cannot fail now
+ generate `let'-bindings rather than `match'-bindings.
+
+ * More efficient code generated in many cases: for example no
+ reference cell is generated when there are no conditional
+ patterns in the `with' guards.
+
+ * Documentation (see http://code.google.com/p/ocaml-patterns/wiki/PatternGuards)
+
+------------------------------------------------------------------------------
+0.1
+
+Initial release
20 COPYING
@@ -0,0 +1,20 @@
+Copyright (c) 2008 Jeremy Yallop
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
8 Makefile
@@ -0,0 +1,8 @@
+OCAMLMAKEFILE = ./OCamlMakefile
+
+SOURCES := traverse.mli traverse.ml patterns.ml
+USE_CAMLP4 := yes
+
+all: traverse.cmi traverse.cmo patterns.cmo
+
+include $(OCAMLMAKEFILE)
1,239 OCamlMakefile
@@ -0,0 +1,1239 @@
+###########################################################################
+# OCamlMakefile
+# Copyright (C) 1999-2007 Markus Mottl
+#
+# For updates see:
+# http://www.ocaml.info/home/ocaml_sources.html
+#
+###########################################################################
+
+# Modified by damien for .glade.ml compilation
+
+# Set these variables to the names of the sources to be processed and
+# the result variable. Order matters during linkage!
+
+ifndef SOURCES
+ SOURCES := foo.ml
+endif
+export SOURCES
+
+ifndef RES_CLIB_SUF
+ RES_CLIB_SUF := _stubs
+endif
+export RES_CLIB_SUF
+
+ifndef RESULT
+ RESULT := foo
+endif
+export RESULT := $(strip $(RESULT))
+
+export LIB_PACK_NAME
+
+ifndef DOC_FILES
+ DOC_FILES := $(filter %.mli, $(SOURCES))
+endif
+export DOC_FILES
+FIRST_DOC_FILE := $(firstword $(DOC_FILES))
+
+export BCSUFFIX
+export NCSUFFIX
+
+ifndef TOPSUFFIX
+ TOPSUFFIX := .top
+endif
+export TOPSUFFIX
+
+# Eventually set include- and library-paths, libraries to link,
+# additional compilation-, link- and ocamlyacc-flags
+# Path- and library information needs not be written with "-I" and such...
+# Define THREADS if you need it, otherwise leave it unset (same for
+# USE_CAMLP4)!
+
+export THREADS
+export VMTHREADS
+export ANNOTATE
+export USE_CAMLP4
+
+export INCDIRS
+export LIBDIRS
+export EXTLIBDIRS
+export RESULTDEPS
+export OCAML_DEFAULT_DIRS
+
+export LIBS
+export CLIBS
+export CFRAMEWORKS
+
+export OCAMLFLAGS
+export OCAMLNCFLAGS
+export OCAMLBCFLAGS
+
+export OCAMLLDFLAGS
+export OCAMLNLDFLAGS
+export OCAMLBLDFLAGS
+
+export OCAMLMKLIB_FLAGS
+
+ifndef OCAMLCPFLAGS
+ OCAMLCPFLAGS := a
+endif
+export OCAMLCPFLAGS
+
+ifndef DOC_DIR
+ DOC_DIR := doc
+endif
+export DOC_DIR
+
+export PPFLAGS
+
+export LFLAGS
+export YFLAGS
+export IDLFLAGS
+
+export OCAMLDOCFLAGS
+
+export OCAMLFIND_INSTFLAGS
+
+export DVIPSFLAGS
+
+export STATIC
+
+# Add a list of optional trash files that should be deleted by "make clean"
+export TRASH
+
+ECHO := echo
+
+ifdef REALLY_QUIET
+ export REALLY_QUIET
+ ECHO := true
+ LFLAGS := $(LFLAGS) -q
+ YFLAGS := $(YFLAGS) -q
+endif
+
+#################### variables depending on your OCaml-installation
+
+ifdef MINGW
+ export MINGW
+ WIN32 := 1
+ CFLAGS_WIN32 := -mno-cygwin
+endif
+ifdef MSVC
+ export MSVC
+ WIN32 := 1
+ ifndef STATIC
+ CPPFLAGS_WIN32 := -DCAML_DLL
+ endif
+ CFLAGS_WIN32 += -nologo
+ EXT_OBJ := obj
+ EXT_LIB := lib
+ ifeq ($(CC),gcc)
+ # work around GNU Make default value
+ ifdef THREADS
+ CC := cl -MT
+ else
+ CC := cl
+ endif
+ endif
+ ifeq ($(CXX),g++)
+ # work around GNU Make default value
+ CXX := $(CC)
+ endif
+ CFLAG_O := -Fo
+endif
+ifdef WIN32
+ EXT_CXX := cpp
+ EXE := .exe
+endif
+
+ifndef EXT_OBJ
+ EXT_OBJ := o
+endif
+ifndef EXT_LIB
+ EXT_LIB := a
+endif
+ifndef EXT_CXX
+ EXT_CXX := cc
+endif
+ifndef EXE
+ EXE := # empty
+endif
+ifndef CFLAG_O
+ CFLAG_O := -o # do not delete this comment (preserves trailing whitespace)!
+endif
+
+export CC
+export CXX
+export CFLAGS
+export CXXFLAGS
+export LDFLAGS
+export CPPFLAGS
+
+ifndef RPATH_FLAG
+ ifdef ELF_RPATH_FLAG
+ RPATH_FLAG := $(ELF_RPATH_FLAG)
+ else
+ RPATH_FLAG := -R
+ endif
+endif
+export RPATH_FLAG
+
+ifndef MSVC
+ifndef PIC_CFLAGS
+ PIC_CFLAGS := -fPIC
+endif
+ifndef PIC_CPPFLAGS
+ PIC_CPPFLAGS := -DPIC
+endif
+endif
+
+export PIC_CFLAGS
+export PIC_CPPFLAGS
+
+BCRESULT := $(addsuffix $(BCSUFFIX), $(RESULT))
+NCRESULT := $(addsuffix $(NCSUFFIX), $(RESULT))
+TOPRESULT := $(addsuffix $(TOPSUFFIX), $(RESULT))
+
+ifndef OCAMLFIND
+ OCAMLFIND := ocamlfind
+endif
+export OCAMLFIND
+
+ifndef OCAMLC
+ OCAMLC := ocamlc
+endif
+export OCAMLC
+
+ifndef OCAMLOPT
+ OCAMLOPT := ocamlopt
+endif
+export OCAMLOPT
+
+ifndef OCAMLMKTOP
+ OCAMLMKTOP := ocamlmktop
+endif
+export OCAMLMKTOP
+
+ifndef OCAMLCP
+ OCAMLCP := ocamlcp
+endif
+export OCAMLCP
+
+ifndef OCAMLDEP
+ OCAMLDEP := ocamldep
+endif
+export OCAMLDEP
+
+ifndef OCAMLLEX
+ OCAMLLEX := ocamllex
+endif
+export OCAMLLEX
+
+ifndef OCAMLYACC
+ OCAMLYACC := ocamlyacc
+endif
+export OCAMLYACC
+
+ifndef OCAMLMKLIB
+ OCAMLMKLIB := ocamlmklib
+endif
+export OCAMLMKLIB
+
+ifndef OCAML_GLADECC
+ OCAML_GLADECC := lablgladecc2
+endif
+export OCAML_GLADECC
+
+ifndef OCAML_GLADECC_FLAGS
+ OCAML_GLADECC_FLAGS :=
+endif
+export OCAML_GLADECC_FLAGS
+
+ifndef CAMELEON_REPORT
+ CAMELEON_REPORT := report
+endif
+export CAMELEON_REPORT
+
+ifndef CAMELEON_REPORT_FLAGS
+ CAMELEON_REPORT_FLAGS :=
+endif
+export CAMELEON_REPORT_FLAGS
+
+ifndef CAMELEON_ZOGGY
+ CAMELEON_ZOGGY := camlp4o pa_zog.cma pr_o.cmo
+endif
+export CAMELEON_ZOGGY
+
+ifndef CAMELEON_ZOGGY_FLAGS
+ CAMELEON_ZOGGY_FLAGS :=
+endif
+export CAMELEON_ZOGGY_FLAGS
+
+ifndef OXRIDL
+ OXRIDL := oxridl
+endif
+export OXRIDL
+
+ifndef CAMLIDL
+ CAMLIDL := camlidl
+endif
+export CAMLIDL
+
+ifndef CAMLIDLDLL
+ CAMLIDLDLL := camlidldll
+endif
+export CAMLIDLDLL
+
+ifndef NOIDLHEADER
+ MAYBE_IDL_HEADER := -header
+endif
+export NOIDLHEADER
+
+export NO_CUSTOM
+
+ifndef CAMLP4
+ CAMLP4 := camlp4
+endif
+export CAMLP4
+
+ifndef REAL_OCAMLFIND
+ ifdef PACKS
+ ifndef CREATE_LIB
+ ifdef THREADS
+ PACKS += threads
+ endif
+ endif
+ empty :=
+ space := $(empty) $(empty)
+ comma := ,
+ ifdef PREDS
+ PRE_OCAML_FIND_PREDICATES := $(subst $(space),$(comma),$(PREDS))
+ PRE_OCAML_FIND_PACKAGES := $(subst $(space),$(comma),$(PACKS))
+ OCAML_FIND_PREDICATES := -predicates $(PRE_OCAML_FIND_PREDICATES)
+ # OCAML_DEP_PREDICATES := -syntax $(PRE_OCAML_FIND_PREDICATES)
+ OCAML_FIND_PACKAGES := $(OCAML_FIND_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES)
+ OCAML_DEP_PACKAGES := $(OCAML_DEP_PREDICATES) -package $(PRE_OCAML_FIND_PACKAGES)
+ else
+ OCAML_FIND_PACKAGES := -package $(subst $(space),$(comma),$(PACKS))
+ OCAML_DEP_PACKAGES :=
+ endif
+ OCAML_FIND_LINKPKG := -linkpkg
+ REAL_OCAMLFIND := $(OCAMLFIND)
+ endif
+endif
+
+export OCAML_FIND_PACKAGES
+export OCAML_DEP_PACKAGES
+export OCAML_FIND_LINKPKG
+export REAL_OCAMLFIND
+
+ifndef OCAMLDOC
+ OCAMLDOC := ocamldoc
+endif
+export OCAMLDOC
+
+ifndef LATEX
+ LATEX := latex
+endif
+export LATEX
+
+ifndef DVIPS
+ DVIPS := dvips
+endif
+export DVIPS
+
+ifndef PS2PDF
+ PS2PDF := ps2pdf
+endif
+export PS2PDF
+
+ifndef OCAMLMAKEFILE
+ OCAMLMAKEFILE := OCamlMakefile
+endif
+export OCAMLMAKEFILE
+
+ifndef OCAMLLIBPATH
+ OCAMLLIBPATH := \
+ $(shell $(OCAMLC) 2>/dev/null -where || echo /usr/local/lib/ocaml)
+endif
+export OCAMLLIBPATH
+
+ifndef OCAML_LIB_INSTALL
+ OCAML_LIB_INSTALL := $(OCAMLLIBPATH)/contrib
+endif
+export OCAML_LIB_INSTALL
+
+###########################################################################
+
+#################### change following sections only if
+#################### you know what you are doing!
+
+# delete target files when a build command fails
+.PHONY: .DELETE_ON_ERROR
+.DELETE_ON_ERROR:
+
+# for pedants using "--warn-undefined-variables"
+export MAYBE_IDL
+export REAL_RESULT
+export CAMLIDLFLAGS
+export THREAD_FLAG
+export RES_CLIB
+export MAKEDLL
+export ANNOT_FLAG
+export C_OXRIDL
+export SUBPROJS
+export CFLAGS_WIN32
+export CPPFLAGS_WIN32
+
+INCFLAGS :=
+
+SHELL := /bin/sh
+
+MLDEPDIR := ._d
+BCDIDIR := ._bcdi
+NCDIDIR := ._ncdi
+
+FILTER_EXTNS := %.mli %.ml %.mll %.mly %.idl %.oxridl %.c %.m %.$(EXT_CXX) %.rep %.zog %.glade
+
+FILTERED := $(filter $(FILTER_EXTNS), $(SOURCES))
+SOURCE_DIRS := $(filter-out ./, $(sort $(dir $(FILTERED))))
+
+FILTERED_REP := $(filter %.rep, $(FILTERED))
+DEP_REP := $(FILTERED_REP:%.rep=$(MLDEPDIR)/%.d)
+AUTO_REP := $(FILTERED_REP:.rep=.ml)
+
+FILTERED_ZOG := $(filter %.zog, $(FILTERED))
+DEP_ZOG := $(FILTERED_ZOG:%.zog=$(MLDEPDIR)/%.d)
+AUTO_ZOG := $(FILTERED_ZOG:.zog=.ml)
+
+FILTERED_GLADE := $(filter %.glade, $(FILTERED))
+DEP_GLADE := $(FILTERED_GLADE:%.glade=$(MLDEPDIR)/%.d)
+AUTO_GLADE := $(FILTERED_GLADE:.glade=.ml)
+
+FILTERED_ML := $(filter %.ml, $(FILTERED))
+DEP_ML := $(FILTERED_ML:%.ml=$(MLDEPDIR)/%.d)
+
+FILTERED_MLI := $(filter %.mli, $(FILTERED))
+DEP_MLI := $(FILTERED_MLI:.mli=.di)
+
+FILTERED_MLL := $(filter %.mll, $(FILTERED))
+DEP_MLL := $(FILTERED_MLL:%.mll=$(MLDEPDIR)/%.d)
+AUTO_MLL := $(FILTERED_MLL:.mll=.ml)
+
+FILTERED_MLY := $(filter %.mly, $(FILTERED))
+DEP_MLY := $(FILTERED_MLY:%.mly=$(MLDEPDIR)/%.d) $(FILTERED_MLY:.mly=.di)
+AUTO_MLY := $(FILTERED_MLY:.mly=.mli) $(FILTERED_MLY:.mly=.ml)
+
+FILTERED_IDL := $(filter %.idl, $(FILTERED))
+DEP_IDL := $(FILTERED_IDL:%.idl=$(MLDEPDIR)/%.d) $(FILTERED_IDL:.idl=.di)
+C_IDL := $(FILTERED_IDL:%.idl=%_stubs.c)
+ifndef NOIDLHEADER
+ C_IDL += $(FILTERED_IDL:.idl=.h)
+endif
+OBJ_C_IDL := $(FILTERED_IDL:%.idl=%_stubs.$(EXT_OBJ))
+AUTO_IDL := $(FILTERED_IDL:.idl=.mli) $(FILTERED_IDL:.idl=.ml) $(C_IDL)
+
+FILTERED_OXRIDL := $(filter %.oxridl, $(FILTERED))
+DEP_OXRIDL := $(FILTERED_OXRIDL:%.oxridl=$(MLDEPDIR)/%.d) $(FILTERED_OXRIDL:.oxridl=.di)
+AUTO_OXRIDL := $(FILTERED_OXRIDL:.oxridl=.mli) $(FILTERED_OXRIDL:.oxridl=.ml) $(C_OXRIDL)
+
+FILTERED_C_CXX := $(filter %.c %.m %.$(EXT_CXX), $(FILTERED))
+OBJ_C_CXX := $(FILTERED_C_CXX:.c=.$(EXT_OBJ))
+OBJ_C_CXX := $(OBJ_C_CXX:.m=.$(EXT_OBJ))
+OBJ_C_CXX := $(OBJ_C_CXX:.$(EXT_CXX)=.$(EXT_OBJ))
+
+PRE_TARGETS += $(AUTO_MLL) $(AUTO_MLY) $(AUTO_IDL) $(AUTO_OXRIDL) $(AUTO_ZOG) $(AUTO_REP) $(AUTO_GLADE)
+
+ALL_DEPS := $(DEP_ML) $(DEP_MLI) $(DEP_MLL) $(DEP_MLY) $(DEP_IDL) $(DEP_OXRIDL) $(DEP_ZOG) $(DEP_REP) $(DEP_GLADE)
+
+MLDEPS := $(filter %.d, $(ALL_DEPS))
+MLIDEPS := $(filter %.di, $(ALL_DEPS))
+BCDEPIS := $(MLIDEPS:%.di=$(BCDIDIR)/%.di)
+NCDEPIS := $(MLIDEPS:%.di=$(NCDIDIR)/%.di)
+
+ALLML := $(filter %.mli %.ml %.mll %.mly %.idl %.oxridl %.rep %.zog %.glade, $(FILTERED))
+
+IMPLO_INTF := $(ALLML:%.mli=%.mli.__)
+IMPLO_INTF := $(foreach file, $(IMPLO_INTF), \
+ $(basename $(file)).cmi $(basename $(file)).cmo)
+IMPLO_INTF := $(filter-out %.mli.cmo, $(IMPLO_INTF))
+IMPLO_INTF := $(IMPLO_INTF:%.mli.cmi=%.cmi)
+
+IMPLX_INTF := $(IMPLO_INTF:.cmo=.cmx)
+
+INTF := $(filter %.cmi, $(IMPLO_INTF))
+IMPL_CMO := $(filter %.cmo, $(IMPLO_INTF))
+IMPL_CMX := $(IMPL_CMO:.cmo=.cmx)
+IMPL_ASM := $(IMPL_CMO:.cmo=.asm)
+IMPL_S := $(IMPL_CMO:.cmo=.s)
+
+OBJ_LINK := $(OBJ_C_IDL) $(OBJ_C_CXX)
+OBJ_FILES := $(IMPL_CMO:.cmo=.$(EXT_OBJ)) $(OBJ_LINK)
+
+EXECS := $(addsuffix $(EXE), \
+ $(sort $(TOPRESULT) $(BCRESULT) $(NCRESULT)))
+ifdef WIN32
+ EXECS += $(BCRESULT).dll $(NCRESULT).dll
+endif
+
+CLIB_BASE := $(RESULT)$(RES_CLIB_SUF)
+ifneq ($(strip $(OBJ_LINK)),)
+ RES_CLIB := lib$(CLIB_BASE).$(EXT_LIB)
+endif
+
+ifdef WIN32
+DLLSONAME := $(CLIB_BASE).dll
+else
+DLLSONAME := dll$(CLIB_BASE).so
+endif
+
+NONEXECS := $(INTF) $(IMPL_CMO) $(IMPL_CMX) $(IMPL_ASM) $(IMPL_S) \
+ $(OBJ_FILES) $(PRE_TARGETS) $(BCRESULT).cma $(NCRESULT).cmxa \
+ $(NCRESULT).$(EXT_LIB) $(BCRESULT).cmi $(BCRESULT).cmo \
+ $(NCRESULT).cmi $(NCRESULT).cmx $(NCRESULT).o \
+ $(RES_CLIB) $(IMPL_CMO:.cmo=.annot) \
+ $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(LIB_PACK_NAME).cmx $(LIB_PACK_NAME).o
+
+ifndef STATIC
+ NONEXECS += $(DLLSONAME)
+endif
+
+ifndef LIBINSTALL_FILES
+ LIBINSTALL_FILES := $(RESULT).mli $(RESULT).cmi $(RESULT).cma \
+ $(RESULT).cmxa $(RESULT).$(EXT_LIB) $(RES_CLIB)
+ ifndef STATIC
+ ifneq ($(strip $(OBJ_LINK)),)
+ LIBINSTALL_FILES += $(DLLSONAME)
+ endif
+ endif
+endif
+
+export LIBINSTALL_FILES
+
+ifdef WIN32
+ # some extra stuff is created while linking DLLs
+ NONEXECS += $(BCRESULT).$(EXT_LIB) $(BCRESULT).exp $(NCRESULT).exp $(CLIB_BASE).exp $(CLIB_BASE).lib
+endif
+
+TARGETS := $(EXECS) $(NONEXECS)
+
+# If there are IDL-files
+ifneq ($(strip $(FILTERED_IDL)),)
+ MAYBE_IDL := -cclib -lcamlidl
+endif
+
+ifdef USE_CAMLP4
+ CAMLP4PATH := \
+ $(shell $(CAMLP4) -where 2>/dev/null || echo /usr/local/lib/camlp4)
+ INCFLAGS := -I $(CAMLP4PATH)
+ CINCFLAGS := -I$(CAMLP4PATH)
+endif
+
+DINCFLAGS := $(INCFLAGS) $(SOURCE_DIRS:%=-I %) $(OCAML_DEFAULT_DIRS:%=-I %)
+INCFLAGS := $(DINCFLAGS) $(INCDIRS:%=-I %)
+CINCFLAGS += $(SOURCE_DIRS:%=-I%) $(INCDIRS:%=-I%) $(OCAML_DEFAULT_DIRS:%=-I%)
+
+ifndef MSVC
+ CLIBFLAGS += $(SOURCE_DIRS:%=-L%) $(LIBDIRS:%=-L%) \
+ $(EXTLIBDIRS:%=-L%) $(OCAML_DEFAULT_DIRS:%=-L%)
+
+ ifeq ($(ELF_RPATH), yes)
+ CLIBFLAGS += $(EXTLIBDIRS:%=-Wl,$(RPATH_FLAG)%)
+ endif
+endif
+
+ifndef PROFILING
+ INTF_OCAMLC := $(OCAMLC)
+else
+ ifndef THREADS
+ INTF_OCAMLC := $(OCAMLCP) -p $(OCAMLCPFLAGS)
+ else
+ # OCaml does not support profiling byte code
+ # with threads (yet), therefore we force an error.
+ ifndef REAL_OCAMLC
+ $(error Profiling of multithreaded byte code not yet supported by OCaml)
+ endif
+ INTF_OCAMLC := $(OCAMLC)
+ endif
+endif
+
+ifndef MSVC
+ COMMON_LDFLAGS := $(LDFLAGS:%=-ccopt %) $(SOURCE_DIRS:%=-ccopt -L%) \
+ $(LIBDIRS:%=-ccopt -L%) $(EXTLIBDIRS:%=-ccopt -L%) \
+ $(EXTLIBDIRS:%=-ccopt -Wl $(OCAML_DEFAULT_DIRS:%=-ccopt -L%))
+
+ ifeq ($(ELF_RPATH),yes)
+ COMMON_LDFLAGS += $(EXTLIBDIRS:%=-ccopt -Wl,$(RPATH_FLAG)%)
+ endif
+else
+ COMMON_LDFLAGS := -ccopt "/link -NODEFAULTLIB:LIBC $(LDFLAGS:%=%) $(SOURCE_DIRS:%=-LIBPATH:%) \
+ $(LIBDIRS:%=-LIBPATH:%) $(EXTLIBDIRS:%=-LIBPATH:%) \
+ $(OCAML_DEFAULT_DIRS:%=-LIBPATH:%) "
+endif
+
+CLIBS_OPTS := $(CLIBS:%=-cclib -l%) $(CFRAMEWORKS:%=-cclib '-framework %')
+ifdef MSVC
+ ifndef STATIC
+ # MSVC libraries do not have 'lib' prefix
+ CLIBS_OPTS := $(CLIBS:%=-cclib %.lib)
+ endif
+endif
+
+ifneq ($(strip $(OBJ_LINK)),)
+ ifdef CREATE_LIB
+ OBJS_LIBS := -cclib -l$(CLIB_BASE) $(CLIBS_OPTS) $(MAYBE_IDL)
+ else
+ OBJS_LIBS := $(OBJ_LINK) $(CLIBS_OPTS) $(MAYBE_IDL)
+ endif
+else
+ OBJS_LIBS := $(CLIBS_OPTS) $(MAYBE_IDL)
+endif
+
+# If we have to make byte-code
+ifndef REAL_OCAMLC
+ BYTE_OCAML := y
+
+ # EXTRADEPS is added dependencies we have to insert for all
+ # executable files we generate. Ideally it should be all of the
+ # libraries we use, but it's hard to find the ones that get searched on
+ # the path since I don't know the paths built into the compiler, so
+ # just include the ones with slashes in their names.
+ EXTRADEPS := $(addsuffix .cma,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i))))
+ SPECIAL_OCAMLFLAGS := $(OCAMLBCFLAGS)
+
+ REAL_OCAMLC := $(INTF_OCAMLC)
+
+ REAL_IMPL := $(IMPL_CMO)
+ REAL_IMPL_INTF := $(IMPLO_INTF)
+ IMPL_SUF := .cmo
+
+ DEPFLAGS :=
+ MAKE_DEPS := $(MLDEPS) $(BCDEPIS)
+
+ ifdef CREATE_LIB
+ override CFLAGS := $(PIC_CFLAGS) $(CFLAGS)
+ override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS)
+ ifndef STATIC
+ ifneq ($(strip $(OBJ_LINK)),)
+ MAKEDLL := $(DLLSONAME)
+ ALL_LDFLAGS := -dllib $(DLLSONAME)
+ endif
+ endif
+ endif
+
+ ifndef NO_CUSTOM
+ ifneq "$(strip $(OBJ_LINK) $(THREADS) $(MAYBE_IDL) $(CLIBS) $(CFRAMEWORKS))" ""
+ ALL_LDFLAGS += -custom
+ endif
+ endif
+
+ ALL_LDFLAGS += $(INCFLAGS) $(OCAMLLDFLAGS) $(OCAMLBLDFLAGS) \
+ $(COMMON_LDFLAGS) $(LIBS:%=%.cma)
+ CAMLIDLDLLFLAGS :=
+
+ ifdef THREADS
+ ifdef VMTHREADS
+ THREAD_FLAG := -vmthread
+ else
+ THREAD_FLAG := -thread
+ endif
+ ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
+ ifndef CREATE_LIB
+ ifndef REAL_OCAMLFIND
+ ALL_LDFLAGS := unix.cma threads.cma $(ALL_LDFLAGS)
+ endif
+ endif
+ endif
+
+# we have to make native-code
+else
+ EXTRADEPS := $(addsuffix .cmxa,$(foreach i,$(LIBS),$(if $(findstring /,$(i)),$(i))))
+ ifndef PROFILING
+ SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS)
+ PLDFLAGS :=
+ else
+ SPECIAL_OCAMLFLAGS := -p $(OCAMLNCFLAGS)
+ PLDFLAGS := -p
+ endif
+
+ ifndef LIB_PACK_NAME
+ SPECIAL_OCAMLFLAGS := $(OCAMLNCFLAGS)
+ else
+ SPECIAL_OCAMLFLAGS := -for-pack $(LIB_PACK_NAME) $(OCAMLNCFLAGS)
+ endif
+ REAL_IMPL := $(IMPL_CMX)
+ REAL_IMPL_INTF := $(IMPLX_INTF)
+ IMPL_SUF := .cmx
+
+ override CPPFLAGS := -DNATIVE_CODE $(CPPFLAGS)
+
+ DEPFLAGS := -native
+ MAKE_DEPS := $(MLDEPS) $(NCDEPIS)
+
+ ALL_LDFLAGS := $(PLDFLAGS) $(INCFLAGS) $(OCAMLLDFLAGS) \
+ $(OCAMLNLDFLAGS) $(COMMON_LDFLAGS)
+ CAMLIDLDLLFLAGS := -opt
+
+ ifndef CREATE_LIB
+ ALL_LDFLAGS += $(LIBS:%=%.cmxa)
+ else
+ override CFLAGS := $(PIC_CFLAGS) $(CFLAGS)
+ override CPPFLAGS := $(PIC_CPPFLAGS) $(CPPFLAGS)
+ endif
+
+ ifdef THREADS
+ THREAD_FLAG := -thread
+ ALL_LDFLAGS := $(THREAD_FLAG) $(ALL_LDFLAGS)
+ ifndef CREATE_LIB
+ ifndef REAL_OCAMLFIND
+ ALL_LDFLAGS := unix.cmxa threads.cmxa $(ALL_LDFLAGS)
+ endif
+ endif
+ endif
+endif
+
+export MAKE_DEPS
+
+ifdef ANNOTATE
+ ANNOT_FLAG := -dtypes
+else
+endif
+
+ALL_OCAMLCFLAGS := $(THREAD_FLAG) $(ANNOT_FLAG) $(OCAMLFLAGS) \
+ $(INCFLAGS) $(SPECIAL_OCAMLFLAGS)
+
+ifdef make_deps
+ -include $(MAKE_DEPS)
+ PRE_TARGETS :=
+endif
+
+###########################################################################
+# USER RULES
+
+# Call "OCamlMakefile QUIET=" to get rid of all of the @'s.
+QUIET=@
+
+# generates byte-code (default)
+byte-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes
+bc: byte-code
+
+byte-code-nolink: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes
+bcnl: byte-code-nolink
+
+top: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(TOPRESULT) \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes
+
+# generates native-code
+
+native-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ make_deps=yes
+nc: native-code
+
+native-code-nolink: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ make_deps=yes
+ncnl: native-code-nolink
+
+# generates byte-code libraries
+byte-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(BCRESULT).cma \
+ REAL_RESULT="$(BCRESULT)" \
+ CREATE_LIB=yes \
+ make_deps=yes
+bcl: byte-code-library
+
+# generates native-code libraries
+native-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(NCRESULT).cmxa \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ CREATE_LIB=yes \
+ make_deps=yes
+ncl: native-code-library
+
+ifdef WIN32
+# generates byte-code dll
+byte-code-dll: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(BCRESULT).dll \
+ REAL_RESULT="$(BCRESULT)" \
+ make_deps=yes
+bcd: byte-code-dll
+
+# generates native-code dll
+native-code-dll: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(NCRESULT).dll \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ make_deps=yes
+ncd: native-code-dll
+endif
+
+# generates byte-code with debugging information
+debug-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes \
+ OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dc: debug-code
+
+debug-code-nolink: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes \
+ OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dcnl: debug-code-nolink
+
+# generates byte-code with debugging information (native code)
+debug-native-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \
+ REAL_RESULT="$(NCRESULT)" make_deps=yes \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dnc: debug-native-code
+
+debug-native-code-nolink: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) nolink \
+ REAL_RESULT="$(NCRESULT)" make_deps=yes \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dncnl: debug-native-code-nolink
+
+# generates byte-code libraries with debugging information
+debug-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(BCRESULT).cma \
+ REAL_RESULT="$(BCRESULT)" make_deps=yes \
+ CREATE_LIB=yes \
+ OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dcl: debug-code-library
+
+# generates byte-code libraries with debugging information (native code)
+debug-native-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(NCRESULT).cma \
+ REAL_RESULT="$(NCRESULT)" make_deps=yes \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ CREATE_LIB=yes \
+ OCAMLFLAGS="-g $(OCAMLFLAGS)" \
+ OCAMLLDFLAGS="-g $(OCAMLLDFLAGS)"
+dncl: debug-native-code-library
+
+# generates byte-code for profiling
+profiling-byte-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT) \
+ REAL_RESULT="$(BCRESULT)" PROFILING="y" \
+ make_deps=yes
+pbc: profiling-byte-code
+
+# generates native-code
+
+profiling-native-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(NCRESULT) \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ PROFILING="y" \
+ make_deps=yes
+pnc: profiling-native-code
+
+# generates byte-code libraries
+profiling-byte-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(BCRESULT).cma \
+ REAL_RESULT="$(BCRESULT)" PROFILING="y" \
+ CREATE_LIB=yes \
+ make_deps=yes
+pbcl: profiling-byte-code-library
+
+# generates native-code libraries
+profiling-native-code-library: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(RES_CLIB) $(NCRESULT).cmxa \
+ REAL_RESULT="$(NCRESULT)" PROFILING="y" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ CREATE_LIB=yes \
+ make_deps=yes
+pncl: profiling-native-code-library
+
+# packs byte-code objects
+pack-byte-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) $(BCRESULT).cmo \
+ REAL_RESULT="$(BCRESULT)" \
+ PACK_LIB=yes make_deps=yes
+pabc: pack-byte-code
+
+# packs native-code objects
+pack-native-code: $(PRE_TARGETS)
+ $(QUIET)$(MAKE) -r -f $(OCAMLMAKEFILE) \
+ $(NCRESULT).cmx $(NCRESULT).o \
+ REAL_RESULT="$(NCRESULT)" \
+ REAL_OCAMLC="$(OCAMLOPT)" \
+ PACK_LIB=yes make_deps=yes
+panc: pack-native-code
+
+# generates HTML-documentation
+htdoc: $(DOC_DIR)/$(RESULT)/html/index.html
+
+# generates Latex-documentation
+ladoc: $(DOC_DIR)/$(RESULT)/latex/doc.tex
+
+# generates PostScript-documentation
+psdoc: $(DOC_DIR)/$(RESULT)/latex/doc.ps
+
+# generates PDF-documentation
+pdfdoc: $(DOC_DIR)/$(RESULT)/latex/doc.pdf
+
+# generates all supported forms of documentation
+doc: htdoc ladoc psdoc pdfdoc
+
+###########################################################################
+# LOW LEVEL RULES
+
+$(REAL_RESULT): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) \
+ $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \
+ $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \
+ $(REAL_IMPL)
+
+nolink: $(REAL_IMPL_INTF) $(OBJ_LINK)
+
+ifdef WIN32
+$(REAL_RESULT).dll: $(REAL_IMPL_INTF) $(OBJ_LINK)
+ $(CAMLIDLDLL) $(CAMLIDLDLLFLAGS) $(OBJ_LINK) $(CLIBS) \
+ -o $@ $(REAL_IMPL)
+endif
+
+%$(TOPSUFFIX): $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS)
+ $(REAL_OCAMLFIND) $(OCAMLMKTOP) \
+ $(OCAML_FIND_PACKAGES) $(OCAML_FIND_LINKPKG) \
+ $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@$(EXE) \
+ $(REAL_IMPL)
+
+.SUFFIXES: .mli .ml .cmi .cmo .cmx .cma .cmxa .$(EXT_OBJ) \
+ .mly .di .d .$(EXT_LIB) .idl %.oxridl .c .m .$(EXT_CXX) .h .so \
+ .rep .zog .glade
+
+ifndef STATIC
+ifdef MINGW
+$(DLLSONAME): $(OBJ_LINK)
+ $(CC) $(CFLAGS) $(CFLAGS_WIN32) $(OBJ_LINK) -shared -o $@ \
+ -Wl,--whole-archive $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/lib%.a))) \
+ $(OCAMLLIBPATH)/ocamlrun.a \
+ -Wl,--export-all-symbols \
+ -Wl,--no-whole-archive
+else
+ifdef MSVC
+$(DLLSONAME): $(OBJ_LINK)
+ link /NOLOGO /DLL /OUT:$@ $(OBJ_LINK) \
+ $(wildcard $(foreach dir,$(LIBDIRS),$(CLIBS:%=$(dir)/%.lib))) \
+ $(OCAMLLIBPATH)/ocamlrun.lib
+
+else
+$(DLLSONAME): $(OBJ_LINK)
+ $(OCAMLMKLIB) $(INCFLAGS) $(CLIBFLAGS) \
+ -o $(CLIB_BASE) $(OBJ_LINK) $(CLIBS:%=-l%) $(CFRAMEWORKS:%=-framework %) \
+ $(OCAMLMKLIB_FLAGS)
+endif
+endif
+endif
+
+ifndef LIB_PACK_NAME
+$(RESULT).cma: $(REAL_IMPL_INTF) $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@ $(REAL_IMPL)
+
+$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(REAL_IMPL_INTF) $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@ $(REAL_IMPL)
+else
+# Packing a bytecode library
+ifdef BYTE_OCAML
+$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo: $(REAL_IMPL_INTF)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack -o $(LIB_PACK_NAME).cmo $(OCAMLLDFLAGS) $(REAL_IMPL)
+# Packing into a unit which can be transformed into a library
+# Remember the .ml's must have been compiled with -for-pack $(LIB_PACK_NAME)
+else
+$(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx: $(REAL_IMPL_INTF)
+ $(REAL_OCAMLFIND) $(OCAMLOPT) -pack -o $(LIB_PACK_NAME).cmx $(OCAMLLDFLAGS) $(REAL_IMPL)
+endif
+
+$(RESULT).cma: $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmo $(MAKEDLL) $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -a $(ALL_LDFLAGS) $(OBJS_LIBS) -o $@ $(LIB_PACK_NAME).cmo
+
+$(RESULT).cmxa $(RESULT).$(EXT_LIB): $(LIB_PACK_NAME).cmi $(LIB_PACK_NAME).cmx $(EXTRADEPS) $(RESULTDEPS)
+ $(REAL_OCAMLFIND) $(OCAMLOPT) -a $(filter-out -custom, $(ALL_LDFLAGS)) $(OBJS_LIBS) -o $@ $(LIB_PACK_NAME).cmx
+endif
+
+$(RES_CLIB): $(OBJ_LINK)
+ifndef MSVC
+ ifneq ($(strip $(OBJ_LINK)),)
+ $(AR) rcs $@ $(OBJ_LINK)
+ endif
+else
+ ifneq ($(strip $(OBJ_LINK)),)
+ lib -nologo -debugtype:cv -out:$(RES_CLIB) $(OBJ_LINK)
+ endif
+endif
+
+.mli.cmi: $(EXTRADEPS)
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ $(ECHO) $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c $(THREAD_FLAG) $(ANNOT_FLAG) \
+ $(OCAMLFLAGS) $(INCFLAGS) $<; \
+ $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c $(THREAD_FLAG) $(ANNOT_FLAG) \
+ $(OCAMLFLAGS) $(INCFLAGS) $<; \
+ else \
+ $(ECHO) $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c -pp \"$$pp $(PPFLAGS)\" $(THREAD_FLAG) $(ANNOT_FLAG) \
+ $(OCAMLFLAGS) $(INCFLAGS) $<; \
+ $(REAL_OCAMLFIND) $(INTF_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c -pp "$$pp $(PPFLAGS)" $(THREAD_FLAG) $(ANNOT_FLAG) \
+ $(OCAMLFLAGS) $(INCFLAGS) $<; \
+ fi
+
+.ml.cmi .ml.$(EXT_OBJ) .ml.cmx .ml.cmo: $(EXTRADEPS)
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ $(ECHO) $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c $(ALL_OCAMLCFLAGS) $<; \
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c $(ALL_OCAMLCFLAGS) $<; \
+ else \
+ $(ECHO) $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c -pp \"$$pp $(PPFLAGS)\" $(ALL_OCAMLCFLAGS) $<; \
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) $(OCAML_FIND_PACKAGES) \
+ -c -pp "$$pp $(PPFLAGS)" $(ALL_OCAMLCFLAGS) $<; \
+ fi
+
+ifdef PACK_LIB
+$(REAL_RESULT).cmo $(REAL_RESULT).cmx $(REAL_RESULT).o: $(REAL_IMPL_INTF) $(OBJ_LINK) $(EXTRADEPS)
+ $(REAL_OCAMLFIND) $(REAL_OCAMLC) -pack $(ALL_LDFLAGS) \
+ $(OBJS_LIBS) -o $@ $(REAL_IMPL)
+endif
+
+.PRECIOUS: %.ml
+%.ml: %.mll
+ $(OCAMLLEX) $(LFLAGS) $<
+
+.PRECIOUS: %.ml %.mli
+%.ml %.mli: %.mly
+ $(OCAMLYACC) $(YFLAGS) $<
+ $(QUIET)pp=`sed -n -e 's/.*(\*pp \([^*]*\) \*).*/\1/p;q' $<`; \
+ if [ ! -z "$$pp" ]; then \
+ mv $*.ml $*.ml.temporary; \
+ echo "(*pp $$pp $(PPFLAGS)*)" > $*.ml; \
+ cat $*.ml.temporary >> $*.ml; \
+ rm $*.ml.temporary; \
+ mv $*.mli $*.mli.temporary; \
+ echo "(*pp $$pp $(PPFLAGS)*)" > $*.mli; \
+ cat $*.mli.temporary >> $*.mli; \
+ rm $*.mli.temporary; \
+ fi
+
+
+.PRECIOUS: %.ml
+%.ml: %.rep
+ $(CAMELEON_REPORT) $(CAMELEON_REPORT_FLAGS) -gen $<
+
+.PRECIOUS: %.ml
+%.ml: %.zog
+ $(CAMELEON_ZOGGY) $(CAMELEON_ZOGGY_FLAGS) -impl $< > $@
+
+.PRECIOUS: %.ml
+%.ml: %.glade
+ $(OCAML_GLADECC) $(OCAML_GLADECC_FLAGS) $< > $@
+
+.PRECIOUS: %.ml %.mli
+%.ml %.mli: %.oxridl
+ $(OXRIDL) $<
+
+.PRECIOUS: %.ml %.mli %_stubs.c %.h
+%.ml %.mli %_stubs.c %.h: %.idl
+ $(CAMLIDL) $(MAYBE_IDL_HEADER) $(IDLFLAGS) \
+ $(CAMLIDLFLAGS) $<
+ $(QUIET)if [ $(NOIDLHEADER) ]; then touch $*.h; fi
+
+.c.$(EXT_OBJ):
+ $(OCAMLC) -c -cc "$(CC)" -ccopt "$(CFLAGS) \
+ $(CPPFLAGS) $(CPPFLAGS_WIN32) \
+ $(CFLAGS_WIN32) $(CINCFLAGS) $(CFLAG_O)$@ " $<
+
+.m.$(EXT_OBJ):
+ $(CC) -c $(CFLAGS) $(CINCFLAGS) $(CPPFLAGS) \
+ -I'$(OCAMLLIBPATH)' \
+ $< $(CFLAG_O)$@
+
+.$(EXT_CXX).$(EXT_OBJ):
+ $(CXX) -c $(CXXFLAGS) $(CINCFLAGS) $(CPPFLAGS) \
+ -I'$(OCAMLLIBPATH)' \
+ $< $(CFLAG_O)$@
+
+$(MLDEPDIR)/%.d: %.ml
+ $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
+ $(DINCFLAGS) $< \> $@; \
+ $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
+ $(DINCFLAGS) $< > $@; \
+ else \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
+ -pp \"$$pp $(PPFLAGS)\" $(DINCFLAGS) $< \> $@; \
+ $(REAL_OCAMLFIND) $(OCAMLDEP) $(OCAML_DEP_PACKAGES) \
+ -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \
+ fi
+
+$(BCDIDIR)/%.di $(NCDIDIR)/%.di: %.mli
+ $(QUIET)if [ ! -d $(@D) ]; then mkdir -p $(@D); fi
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $<`; \
+ if [ -z "$$pp" ]; then \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< \> $@; \
+ $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) $(DINCFLAGS) $< > $@; \
+ else \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \
+ -pp \"$$pp $(PPFLAGS)\" $(DINCFLAGS) $< \> $@; \
+ $(REAL_OCAMLFIND) $(OCAMLDEP) $(DEPFLAGS) \
+ -pp "$$pp $(PPFLAGS)" $(DINCFLAGS) $< > $@; \
+ fi
+
+$(DOC_DIR)/$(RESULT)/html:
+ mkdir -p $@
+
+$(DOC_DIR)/$(RESULT)/html/index.html: $(DOC_DIR)/$(RESULT)/html $(DOC_FILES)
+ rm -rf $</*
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $(FIRST_DOC_FILE)`; \
+ if [ -z "$$pp" ]; then \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -html -d $< $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \
+ $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -html -d $< $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES); \
+ else \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -pp \"$$pp $(PPFLAGS)\" -html -d $< $(OCAMLDOCFLAGS) \
+ $(INCFLAGS) $(DOC_FILES); \
+ $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -pp "$$pp $(PPFLAGS)" -html -d $< $(OCAMLDOCFLAGS) \
+ $(INCFLAGS) $(DOC_FILES); \
+ fi
+
+$(DOC_DIR)/$(RESULT)/latex:
+ mkdir -p $@
+
+$(DOC_DIR)/$(RESULT)/latex/doc.tex: $(DOC_DIR)/$(RESULT)/latex $(DOC_FILES)
+ rm -rf $</*
+ $(QUIET)pp=`sed -n -e '/^#/d' -e 's/(\*pp \([^*]*\) \*)/\1/p;q' $(FIRST_DOC_FILE)`; \
+ if [ -z "$$pp" ]; then \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) \
+ $(DOC_FILES) -o $@; \
+ $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -latex $(OCAMLDOCFLAGS) $(INCFLAGS) $(DOC_FILES) \
+ -o $@; \
+ else \
+ $(ECHO) $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -pp \"$$pp $(PPFLAGS)\" -latex $(OCAMLDOCFLAGS) \
+ $(INCFLAGS) $(DOC_FILES) -o $@; \
+ $(REAL_OCAMLFIND) $(OCAMLDOC) $(OCAML_FIND_PACKAGES) -pp "$$pp $(PPFLAGS)" -latex $(OCAMLDOCFLAGS) \
+ $(INCFLAGS) $(DOC_FILES) -o $@; \
+ fi
+
+$(DOC_DIR)/$(RESULT)/latex/doc.ps: $(DOC_DIR)/$(RESULT)/latex/doc.tex
+ cd $(DOC_DIR)/$(RESULT)/latex && \
+ $(LATEX) doc.tex && \
+ $(LATEX) doc.tex && \
+ $(DVIPS) $(DVIPSFLAGS) doc.dvi -o $(@F)
+
+$(DOC_DIR)/$(RESULT)/latex/doc.pdf: $(DOC_DIR)/$(RESULT)/latex/doc.ps
+ cd $(DOC_DIR)/$(RESULT)/latex && $(PS2PDF) $(<F)
+
+define make_subproj
+.PHONY:
+subproj_$(1):
+ $$(eval $$(call PROJ_$(1)))
+ $(QUIET)if [ "$(SUBTARGET)" != "all" ]; then \
+ $(MAKE) -f $(OCAMLMAKEFILE) $(SUBTARGET); \
+ fi
+endef
+
+$(foreach subproj,$(SUBPROJS),$(eval $(call make_subproj,$(subproj))))
+
+.PHONY:
+subprojs: $(SUBPROJS:%=subproj_%)
+
+###########################################################################
+# (UN)INSTALL RULES FOR LIBRARIES
+
+.PHONY: libinstall
+libinstall: all
+ $(QUIET)printf "\nInstalling library with ocamlfind\n"
+ $(OCAMLFIND) install $(OCAMLFIND_INSTFLAGS) $(RESULT) META $(LIBINSTALL_FILES)
+ $(QUIET)printf "\nInstallation successful.\n"
+
+.PHONY: libinstall-byte-code
+libinstall-byte-code: all
+ $(QUIET)printf "\nInstalling byte-code library with ocamlfind\n"
+ $(OCAMLFIND) install $(OCAMLFIND_INSTFLAGS) $(RESULT) META \
+ $(filter-out $(RESULT).$(EXT_LIB) $(RESULT).cmxa, $(LIBINSTALL_FILES))
+ $(QUIET)printf "\nInstallation successful.\n"
+
+.PHONY: libinstall-native-code
+libinstall-native-code: all
+ $(QUIET)printf "\nInstalling native-code library with ocamlfind\n"
+ $(OCAMLFIND) install $(OCAMLFIND_INSTFLAGS) $(RESULT) META \
+ $(filter-out $(DLLSONAME) $(RESULT).cma, $(LIBINSTALL_FILES))
+ $(QUIET)printf "\nInstallation successful.\n"
+
+.PHONY: libuninstall
+libuninstall:
+ $(QUIET)printf "\nUninstalling library with ocamlfind\n"
+ $(OCAMLFIND) remove $(OCAMLFIND_INSTFLAGS) $(RESULT)
+ $(QUIET)printf "\nUninstallation successful.\n"
+
+.PHONY: rawinstall
+rawinstall: all
+ $(QUIET)printf "\nInstalling library to: $(OCAML_LIB_INSTALL)\n"
+ -install -d $(OCAML_LIB_INSTALL)
+ for i in $(LIBINSTALL_FILES); do \
+ if [ -f $$i ]; then \
+ install -c -m 0644 $$i $(OCAML_LIB_INSTALL); \
+ fi; \
+ done
+ $(QUIET)printf "\nInstallation successful.\n"
+
+.PHONY: rawuninstall
+rawuninstall:
+ $(QUIET)printf "\nUninstalling library from: $(OCAML_LIB_INSTALL)\n"
+ cd $(OCAML_LIB_INSTALL) && rm $(notdir $(LIBINSTALL_FILES))
+ $(QUIET)printf "\nUninstallation successful.\n"
+
+###########################################################################
+# MAINTENANCE RULES
+
+.PHONY: clean
+clean::
+ rm -f $(TARGETS) $(TRASH)
+ rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR)
+
+.PHONY: cleanup
+cleanup::
+ rm -f $(NONEXECS) $(TRASH)
+ rm -rf $(BCDIDIR) $(NCDIDIR) $(MLDEPDIR)
+
+.PHONY: clean-doc
+clean-doc::
+ rm -rf $(DOC_DIR)/$(RESULT)
+
+.PHONY: clean-all
+clean-all:: clean clean-doc
+
+.PHONY: nobackup
+nobackup:
+ rm -f *.bak *~ *.dup
34 README
@@ -0,0 +1,34 @@
+Note: you'll need OCaml 3.10.x to compile `patterns'.
+
+Typing `make' in this directory should build object files traverse.cmo
+and patterns.cmo, which form a framework for writing extensions to
+pattern-matching using Camlp4. Typing `make' in the applications
+directory then builds a number of extensions which use the framework
+to extend OCaml pattern matching.
+
+For example, once you've built the framework and the applications, you
+can use the pa_lazy extension in applications/lazy to extend OCaml
+with "lazy patterns" (i.e. pattern matching against lazy values). If
+you have a source file "source.ml" which uses lazy patterns then you
+can compile it as follows:
+
+ ocamlc -pp 'camlp4of traverse.cmo patterns.cmo pa_lazy.cmo' source.ml
+
+or, to see the output,
+
+ camlp4of traverse.cmo patterns.cmo pa_lazy.cmo source.ml
+
+If you'd like to check that everything is working, you can run
+
+ make test
+
+in the applications directory.
+
+Documentation for using `patterns' is available at
+
+ http://code.google.com/p/ocaml-patterns/
+
+Comments are very welcome.
+
+Jeremy Yallop
+jeremy.yallop@ed.ac.uk
5 VERSION
@@ -0,0 +1,5 @@
+VERSION : 0.4
+
+
+--
+(Internal version: 558)
11 applications/Makefile
@@ -0,0 +1,11 @@
+DIRS=lazy object negative conjunctive n+k combination
+
+all:
+ @for d in $(DIRS); do (cd $$d && $(MAKE)); done
+
+test:
+ @for d in $(DIRS); do (cd $$d && $(MAKE) test); done
+
+clean:
+ @for d in $(DIRS); do (cd $$d && $(MAKE) clean); done
+
17 applications/Makefile.application
@@ -0,0 +1,17 @@
+OCAMLMAKEFILE = ../../OCamlMakefile
+
+INCDIRS = ../..
+
+USE_CAMLP4 := yes
+
+RESULT = tests
+
+SOURCES := $(TESTS)
+
+PRE_TARGETS := $(patsubst %.ml,%.cmo,$(SYNTAX_EXTENSION))
+TRASH := $(patsubst %.ml,%.cmi,$(SYNTAX_EXTENSION))
+
+include $(OCAMLMAKEFILE)
+
+test: $(RESULT)
+ ./tests
14 applications/README
@@ -0,0 +1,14 @@
+This directory contains various extensions to OCaml pattern-matching
+implemented using the `patterns' extension for OCaml.
+
+lazy/
+ Pattern-matching for lazy values.
+object/
+ Pattern-matching for objects.
+negative/
+ Negative patterns, which match all but a particular set of values.
+conjunctive/
+ Conjunctive patterns, a generalization of as-patterns. These are
+ found in F#, and are useful in conjunction with other extensions.
+n+k/
+ The infamous N+K patterns, as found in Haskell.
3  applications/combination/Makefile
@@ -0,0 +1,3 @@
+TESTS := combination_tests.ml
+
+include ../Makefile.application
34 applications/combination/combination_tests.ml
@@ -0,0 +1,34 @@
+(*pp camlp4of -I ../.. -I ../ traverse.cmo patterns.cmo lazy/pa_lazy.cmo object/pa_object.cmo negative/pa_negative.cmo conjunctive/pa_conjunctive.cmo n+k/pa_nplusk.cmo *)
+
+(* Tests for a combination of extensions *)
+
+let passed = ref true
+
+let test thunk =
+ try Lazy.force thunk
+ with Assert_failure (msg, line, chr) ->
+ passed := false;
+ Printf.fprintf stderr "Test failed: %d:%d (%s)\n" line chr msg;
+ flush stderr
+
+module Tests (S : sig end) =
+struct
+
+ (* match a pattern that combines lazy, object, negative, conjunctive
+ and n+k bindings *)
+ let _ =
+ test
+ (lazy
+ (assert
+ ((let f = function
+ | {| x = lazy ((~ (`A (_+3))) & `A (n+1)); y |} -> n + y
+ in f {| x = lazy (`A 2); y = 12 |})
+ = 13)))
+end
+
+let _ =
+ let module T = Tests(struct end) in
+ if !passed then print_endline "combination tests succeeded!"
+
+
+
4 applications/conjunctive/Makefile
@@ -0,0 +1,4 @@
+SYNTAX_EXTENSION := pa_conjunctive.ml
+TESTS := conjunctive_tests.ml
+
+include ../Makefile.application
25 applications/conjunctive/conjunctive_tests.ml
@@ -0,0 +1,25 @@
+(*pp camlp4of -I ../.. traverse.cmo patterns.cmo pa_conjunctive.cmo *)
+let passed = ref true
+
+let test thunk =
+ try Lazy.force thunk
+ with Assert_failure (msg, line, chr) ->
+ passed := false;
+ Printf.fprintf stderr "Test failed: %d:%d (%s)\n" line chr msg;
+ flush stderr
+
+module Tests (S : sig end) =
+struct
+
+ let _ =
+ test
+ (lazy
+ (assert
+ ((let f ((`A a, b) & (c, `B d)) = (a,b,c,d) in f (`A 3, `B 4))
+ = (3, `B 4, `A 3, 4))))
+end
+
+let _ =
+ let module T = Tests(struct end) in
+ if !passed then print_endline "conjunctive pattern tests succeeded!"
+
15 applications/conjunctive/pa_conjunctive.ml
@@ -0,0 +1,15 @@
+(*pp camlp4of -loc loc -I ../.. traverse.cmo patterns.cmo *)
+open Camlp4.PreCast.Syntax
+
+EXTEND Gram
+ patt:
+ [[p = SELF; "&"; q = SELF -> <:patt< $uid:"&"$ ($p$, $q$) >>]];
+END
+
+object
+ inherit Patterns.extension
+ method translate v = function
+ | <:patt@loc< $uid:"&"$ ($p$, $q$) >> -> Some (<:expr< ($v$, $v$) >> ,
+ <:patt< ($p$, $q$) >>)
+ | _ -> None
+end
4 applications/lazy/Makefile
@@ -0,0 +1,4 @@
+SYNTAX_EXTENSION := pa_lazy.ml
+TESTS := lazy_tests.ml lazy_tests_revised.ml
+
+include ../Makefile.application
201 applications/lazy/lazy_tests.ml
@@ -0,0 +1,201 @@
+(*pp camlp4of -I ../.. traverse.cmo patterns.cmo pa_lazy.cmo *)
+(* Tests for lazy patterns *)
+
+
+let passed = ref true
+
+let test thunk =
+ try Lazy.force thunk
+ with Assert_failure (msg, line, chr) ->
+ passed := false;
+ Printf.fprintf stderr "Test failed: %d:%d (%s)\n" line chr msg;
+ flush stderr
+
+module Tests (S : sig end) =
+struct
+ (* unconditional lazy patterns *)
+ let unconditional_lazy_patterns =
+ test (lazy (assert
+ (match (lazy 2, 3) with
+ | (lazy x, y) -> x + y = 5)))
+
+
+ (* conditional lazy patterns *)
+ let conditional_lazy_patterns_1 =
+ test (lazy
+ (assert
+ (match lazy [lazy (Some 15); lazy None] with
+ | lazy ([lazy (Some _); lazy (Some _); lazy _]) -> false
+ | lazy ([lazy (Some _); lazy None]) -> true
+ | lazy _ -> false)))
+
+ let conditional_lazy_patterns_2 =
+ let rec force_all = function
+ | [] -> []
+ | lazy x :: xs -> x :: force_all xs in
+ test (lazy (assert
+ (force_all ([lazy true; lazy false]) = [true; false])))
+
+
+ (* Patterns are sufficiently lazy *)
+ let patterns_are_sufficiently_lazy =
+ test (lazy
+ (assert
+ (match (lazy None, lazy (failwith "insufficient laziness")) with
+ | lazy (Some _), lazy _ -> false
+ | lazy None, _ -> true)))
+
+ (* let bindings + lazy patterns (allowed)*)
+ let let_bindings_1 =
+ let force (lazy x) = x in
+ test (lazy (assert (force (lazy 3) = 3)))
+
+ let let_bindings_1' =
+ let force = fun (lazy x) -> x in
+ test (lazy (assert (force (lazy 3) = 3)))
+
+ let let_bindings_2 =
+ let lazy x = lazy 2 in
+ test (lazy (assert (x = 2)))
+
+ let let_bindings_3 =
+ let lazy x = lazy 2
+ and lazy y = lazy 3 in
+ test (lazy (assert ((x + y) = 5)))
+
+ let toplevel_let_bindings =
+ test
+ (lazy
+ (assert
+ (let module M =
+ struct
+ let lazy x = lazy 2
+ let v = x
+ end in M.v = 2)))
+
+ let toplevel_let_bindings' =
+ test
+ (lazy
+ (assert
+ (let module M =
+ struct
+ let (Some x, lazy y, [lazy z]) = Some 3, lazy 4, [lazy 5]
+ and (lazy a, lazy b) = lazy 6, lazy 7
+ let v = 25 = x + y + z + a + b
+ end in M.v)))
+
+
+ (* function bindings + lazy patterns (allowed)*)
+ let function_bindings =
+ test
+ (lazy
+ (assert
+ (let force = function
+ | lazy x -> x in
+ force (lazy 3) = 3)))
+
+ (* fun bindings + lazy patterns (allowed)*)
+ let fun_bindings =
+ test
+ (lazy
+ (assert
+ (let force = fun (lazy x) -> x in
+ force (lazy 3) = 3)))
+
+ (* try bindings + lazy patterns (allowed)*)
+ let try_bindings =
+ test (lazy
+ (assert
+ (11 =
+ let module M = struct
+ exception E of int Lazy.t
+ let v =
+ try
+ raise (E (lazy 10))
+ with E (lazy x) when x = 8 -> x
+ | E y -> Lazy.force y + 1
+ end in M.v)))
+
+ (* labeled arguments + lazy patterns*)
+ let labeled_arguments =
+ test
+ (lazy
+ (assert
+ (let force ~v:(lazy x) = x in
+ force ~v:(lazy 10) = 10)))
+
+ (* optional arguments + lazy patterns*)
+ let optional_arguments =
+ test
+ (lazy
+ (assert
+ (let force ?v:(lazy x = lazy 3) () = x in
+ force ~v:(lazy 10) () = 10
+ && force () = 3)))
+
+ (* lazy patterns + or patterns (allowed)*)
+ let lazies_with_or =
+ let f = function
+ | (lazy (xs::[]) | lazy (xs::_)) -> xs in
+ test (lazy (assert (f (lazy [1;2;3]) = f (lazy [1]))))
+
+ (* lazy patterns + relaxed binding rules *)
+
+ let binding_rules =
+ let f = function
+ | (lazy (`A (x,y)) | lazy (`B x)) -> x in
+ test
+ (lazy (assert (f (lazy (`B 3)) = 3)))
+
+ (* lazy patterns + or patterns + relaxed binding rules *)
+(*
+ let binding_rules' =
+ let f = function
+ | `A (a, lazy b, c)
+ | `B (a, lazy x) -> x + a in
+ test
+ (lazy
+ (assert (f (`B (3, lazy 4)) = 7)))
+*)
+
+ (* Class functions *)
+ let class_functions =
+ test
+ (lazy
+ (assert
+ (let module M =
+ struct
+ class c = fun (lazy (v : int)) -> object method m = v end
+ end in
+ (new M.c (lazy 3)) # m = 3)))
+
+ (* Class let *)
+ let class_let =
+ test
+ (lazy
+ (assert
+ (let module M =
+ struct
+ class c = let lazy x = lazy 2 in object method m = x end
+ end in
+ (new M.c) # m = 2)))
+
+ (* This tests for a bug wherein generated bindings were sometimes
+ thrown away *)
+ let _ =
+ test
+ (lazy
+ (assert
+ ((let lazy l = let module M =
+ struct
+ exception E of int lazy_t
+ end
+ in try lazy 3 with M.E (lazy 0) -> assert false in l) = 3)))
+
+
+(* object bindings + lazy patterns disallowed (no test)*)
+end
+
+let _ =
+ let module T = Tests(struct end) in
+ if !passed then print_endline "lazy tests (original syntax) succeeded!"
159 applications/lazy/lazy_tests_revised.ml
@@ -0,0 +1,159 @@
+(*pp camlp4rf -I ../.. traverse.cmo patterns.cmo pa_lazy.cmo *)
+(* Tests for lazy patterns *)
+value passed = ref True;
+value test thunk =
+ try Lazy.force thunk
+ with
+ [ Assert_failure msg line chr ->
+ (passed.val := False;
+ Printf.fprintf stderr "Test failed: %d:%d (%s)\n" line chr msg;
+ flush stderr) ];
+module Tests (S : sig end) =
+ struct
+ (* unconditional lazy patterns *)
+ value unconditional_lazy_patterns =
+ test
+ (lazy
+ (assert (match ((lazy 2), 3) with [ (lazy x, y) -> (x + y) = 5 ])));
+ (* conditional lazy patterns *)
+ value conditional_lazy_patterns_1 =
+ test
+ (lazy
+ (assert
+ (match lazy [ lazy (Some 15); lazy None ] with
+ [ lazy ([ lazy (Some _); lazy (Some _); lazy _ ]) -> False
+ | lazy ([ lazy (Some _); lazy None ]) -> True
+ | lazy _ -> False ])));
+ value conditional_lazy_patterns_2 =
+ let rec force_all =
+ fun [ [] -> [] | [ lazy x :: xs ] -> [ x :: force_all xs ] ]
+ in
+ test
+ (lazy
+ (assert
+ ((force_all [ lazy True; lazy False ]) = [ True; False ])));
+ (* Patterns are sufficiently lazy *)
+ value patterns_are_sufficiently_lazy =
+ test
+ (lazy
+ (assert
+ (match ((lazy None), (lazy (failwith "insufficient laziness")))
+ with
+ [ (lazy (Some _), lazy _) -> False
+ | (lazy None, _) -> True ])));
+ (* let bindings + lazy patterns (allowed)*)
+ value let_bindings_1 =
+ let force = fun [ lazy x -> x ]
+ in test (lazy (assert ((force (lazy 3)) = 3)));
+ value let_bindings_1' =
+ let force = fun [ lazy x -> x ]
+ in test (lazy (assert ((force (lazy 3)) = 3)));
+ value let_bindings_2 =
+ let (lazy x) = lazy 2 in test (lazy (assert (x = 2)));
+ value let_bindings_3 =
+ let (lazy x) = lazy 2
+ and (lazy y) = lazy 3
+ in test (lazy (assert ((x + y) = 5)));
+ value toplevel_let_bindings =
+ test
+ (lazy
+ (assert
+ (let module M =
+ struct value (lazy x) = lazy 2; value v = x; end
+ in M.v = 2)));
+ value toplevel_let_bindings' =
+ test
+ (lazy
+ (assert
+ (let module M =
+ struct
+ value (x, lazy y, lazy z) =
+ ((3), (lazy 4), lazy 5)
+ and (lazy a, lazy b) = ((lazy 6), (lazy 7));
+ value v = 25 = ((((x + y) + z) + a) + b);
+ end
+ in M.v)));
+ (* function bindings + lazy patterns (allowed)*)
+ value function_bindings =
+ test
+ (lazy
+ (assert (let force = fun [ lazy x -> x ] in (force (lazy 3)) = 3)));
+ (* fun bindings + lazy patterns (allowed)*)
+ value fun_bindings =
+ test
+ (lazy
+ (assert (let force = fun [ lazy x -> x ] in (force (lazy 3)) = 3)));
+ (* try bindings + lazy patterns (allowed)*)
+ value try_bindings =
+ test
+ (lazy
+ (assert
+ (11 =
+ (let module M =
+ struct
+ exception E of Lazy.t int;
+ value v =
+ try raise (E (lazy 10))
+ with [ E (lazy x) when x = 8 -> x
+ | E y -> (Lazy.force y) + 1 ];
+ end
+ in M.v))));
+ (* labeled arguments + lazy patterns*)
+ value labeled_arguments =
+ test
+ (lazy
+ (assert
+ (let force = fun [ ~v: (lazy x) -> x ]
+ in (force ~v: (lazy 10)) = 10)));
+ (* optional arguments + lazy patterns*)
+ value optional_arguments =
+ test
+ (lazy
+ (assert
+ (let force = fun [ ?v:(lazy x = lazy 3) -> fun () -> x ]
+ in ((force ~v: (lazy 10) ()) = 10) && ((force ()) = 3))));
+ (* lazy patterns + or patterns (allowed)*)
+ value lazies_with_or =
+ let f = fun [ lazy ([ xs ]) | lazy ([ xs :: _ ]) -> xs ]
+ in test (lazy (assert ((f (lazy [ 1; 2; 3 ])) = (f (lazy [ 1 ])))));
+ (* lazy patterns + relaxed binding rules *)
+ value binding_rules =
+ let f = fun [ lazy (`A x y) | lazy (`B x) -> x ]
+ in test (lazy (assert ((f (lazy (`B 3))) = 3)));
+ (* lazy patterns + or patterns + relaxed binding rules *)
+ (*
+ let binding_rules' =
+ let f = function
+ | `A (a, lazy b, c)
+ | `B (a, lazy x) -> x + a in
+ test
+ (lazy
+ (assert (f (`B (3, lazy 4)) = 7)))
+*)
+ (* Class functions *)
+ value class_functions =
+ test
+ (lazy
+ (assert
+ (let module M =
+ struct
+ class c = fun lazy (v : int) -> object method m = v; end;
+ end
+ in (new M.c (lazy 3))#m = 3)));
+ (* Class let *)
+ value class_let =
+ test
+ (lazy
+ (assert
+ (let module M =
+ struct
+ class c =
+ let (lazy x) = lazy 2
+ in object method m = x; end;
+ end
+ in (new M.c)#m = 2)));
+ end;
+(* object bindings + lazy patterns disallowed (no test)*)
+ let module T = Tests(struct end)
+ in if passed.val then print_endline "lazy tests (revised syntax) succeeded!" else ();
+
22 applications/lazy/pa_lazy.ml
@@ -0,0 +1,22 @@
+(*pp camlp4of -loc loc -I ../.. traverse.cmo patterns.cmo *)
+
+open Camlp4.PreCast.Syntax
+
+EXTEND Gram
+ patt: LEVEL "simple"
+ [LEFTA ["lazy"; p = SELF -> <:patt< $uid:"lazy"$ $p$ >>]];
+
+ (* Extending `ipatt' is only necessary for the revised syntax, in
+ * which let bindings must be syntactically irrefutable. *)
+ ipatt:
+ [LEFTA ["lazy"; p = SELF -> <:patt< $uid:"lazy"$ $p$ >>]];
+END
+
+object
+ inherit Patterns.extension
+ method translate v = function
+ | <:patt@loc< $uid:"lazy"$ $p$ >> -> Some (<:expr< Lazy.force $v$ >>, p)
+ | _ -> None
+end
+
+
4 applications/n+k/Makefile
@@ -0,0 +1,4 @@
+SYNTAX_EXTENSION := pa_nplusk.ml
+TESTS := nplusk_tests.ml
+
+include ../Makefile.application
81 applications/n+k/nplusk_tests.ml
@@ -0,0 +1,81 @@
+(*pp camlp4of -I ../.. traverse.cmo patterns.cmo pa_nplusk.cmo *)
+
+
+let passed = ref true
+
+let test thunk =
+ try Lazy.force thunk
+ with Assert_failure (msg, line, chr) ->
+ passed := false;
+ Printf.fprintf stderr "Test failed: %d:%d (%s)\n" line chr msg;
+ flush stderr
+
+module Tests (S : sig end) =
+struct
+ let rec add = function
+ | 0, n -> n
+ | m+1, n -> 1 + add (m, n)
+
+ let rec add' = function
+ | m+1, n -> 1 + add (m, n)
+ | 0, n -> n
+
+ (* match-binding *)
+ let _ =
+ test
+ (lazy
+ (assert (add (0,0) = 0+0
+ && add (100,0) = 100 + 0
+ && add (0,100) = 0 + 100
+ && add (100,100) = 100 + 100);
+ assert (add' (0,0) = 0+0
+ && add' (100,0) = 100 + 0
+ && add' (0,100) = 0 + 100
+ && add' (100,100) = 100 + 100)))
+
+ (* let-binding *)
+ let _ =
+ (test
+ (lazy
+ (assert
+ ((let n+10 = 12 in n) = 2))))
+
+ (* try-binding *)
+ let _ =
+ test
+ (lazy
+ (assert
+ ((let module M = struct
+ exception E of int
+ end in
+ try
+ raise (M.E 0)
+ with
+ | Not_found -> 1
+ | M.E (n+1) -> 2
+ | M.E 0 -> 3
+ | Failure _ -> 4) = 3)))
+
+ (* fun-binding *)
+ let _ =
+ test
+ (lazy
+ (assert
+ (((fun (n+10) -> n) 12) = 2)))
+
+ (* nesting *)
+ let _ =
+ test
+ (lazy
+ (assert
+ ((let (n+1) = let (n+2) = 12 in n in
+ match (let n+4 = n in n, true) with
+ | (_, false) -> `A
+ | (4, _ ) -> `B
+ | (n+1, _ ) when n > 4 -> `C
+ | (n+2, _ ) -> `D) = `D)))
+end
+
+let _ =
+ let module T = Tests(struct end) in
+ if !passed then print_endline "n+k tests succeeded!"
17 applications/n+k/pa_nplusk.ml
@@ -0,0 +1,17 @@
+(*pp camlp4of -loc loc -I ../.. traverse.cmo patterns.cmo *)
+
+open Camlp4.PreCast.Syntax
+
+EXTEND Gram
+ patt: LEVEL "simple"
+ [LEFTA [n = SELF ; "+" ; k = a_INT -> <:patt< $uid:"+"$ ($n$, $int:k$) >>]];
+END
+
+object
+ inherit Patterns.extension
+ method translate v = function
+ | <:patt@loc< $uid:"+"$ ($p$, $int:k$) >> ->
+ Some (<:expr< ($v$ - $int:k$, ($v$ - $int:k$) >= 0) >>, <:patt< ($p$, true) >>)
+ | _ -> None
+end
+
4 applications/negative/Makefile
@@ -0,0 +1,4 @@
+SYNTAX_EXTENSION := pa_negative.ml
+TESTS := negative_tests.ml
+
+include ../Makefile.application
83 applications/negative/negative_tests.ml
@@ -0,0 +1,83 @@
+(*pp camlp4of -I ../.. traverse.cmo patterns.cmo pa_negative.cmo *)
+
+
+let passed = ref true
+
+let test thunk =
+ try Lazy.force thunk
+ with Assert_failure (msg, line, chr) ->
+ passed := false;
+ Printf.fprintf stderr "Test failed: %d:%d (%s)\n" line chr msg;
+ flush stderr
+
+module Tests (S : sig end) =
+struct
+
+ let nonzero = function
+ | ~0 -> true
+ | _ -> false
+
+ (* simple match-case *)
+ let _ =
+ test
+ (lazy
+ (assert
+ (nonzero 0 = false
+ && nonzero (-1) = true
+ && nonzero max_int = true)))
+
+ (* let binding *)
+ let _ =
+ test
+ (lazy
+ (assert
+ ((let ~`A as x = `B in x) = `B)))
+
+ (* deep let binding *)
+ let _ =
+ test
+ (lazy
+ (assert
+ ((let ((~`A, ~`B) :: ((~`C,_) ::_ as x))
+ = [(`C,`D); (`E,`F)]
+ in x)
+ = [`E,`F])))
+
+ (* more complex match *)
+ let _ =
+ test
+ (lazy
+ (assert
+ ((match (true, Some 3) with
+ | (~true, _) -> assert false
+ | (_, ~(Some 3)) when assert false -> assert false
+ | (_, ~None) when false -> assert false
+ | (~false, Some ~2) when false -> assert false
+ | (~false, Some ~2) -> true) = true)))
+
+
+ (* match with "or" patterns *)
+ let _ =
+ test
+ (lazy
+ (assert
+ ((match (true, Some 3) with
+ | (~true, _) | (_, ~(Some 3)) when assert false -> assert false
+ | (~false, (~None | Some ~2)) when false -> assert false
+ | (~false, Some ~2) -> true) = true)))
+
+ (* match with matches in guard *)
+ let _ =
+ test
+ (lazy
+ (assert
+ ((match (true, Some 3) with
+ | (~true, _) | (_, ~(Some 3)) when assert false -> assert false
+ | (~false, (~None | Some ~2)) when let ~false as x = true in not x -> assert false
+ | (~false, Some ~2) -> true) = true)))
+
+end
+
+let _ =
+ let module T = Tests(struct end) in
+ if !passed then print_endline "negative pattern tests succeeded!"
15 applications/negative/pa_negative.ml
@@ -0,0 +1,15 @@
+(*pp camlp4of -loc loc -I ../.. traverse.cmo patterns.cmo *)
+open Camlp4.PreCast.Syntax
+
+EXTEND Gram
+ patt: LEVEL "simple"
+ [LEFTA ["~"; p = SELF -> <:patt< $uid:"~"$ $p$ >>]];
+END
+
+object
+ inherit Patterns.extension
+ method translate v = function
+ | <:patt@loc< $uid:"~"$ $p$ >> -> Some (<:expr< match $v$ with $p$ -> false | _ -> true >>,
+ <:patt< true >>)
+ | _ -> None
+end
4 applications/object/Makefile
@@ -0,0 +1,4 @@
+SYNTAX_EXTENSION := pa_object.ml
+TESTS := object_tests.ml
+
+include ../Makefile.application
91 applications/object/object_tests.ml
@@ -0,0 +1,91 @@
+(*pp camlp4of -I ../.. traverse.cmo patterns.cmo pa_object.cmo *)
+
+let passed = ref true
+
+let test thunk =
+ try Lazy.force thunk
+ with Assert_failure (msg, line, chr) ->
+ passed := false;
+ Printf.fprintf stderr "Test failed: %d:%d (%s)\n" line chr msg;
+ flush stderr
+
+module Tests (S : sig end) =
+struct
+
+ (* Using objects as structurally-typed records in order to get labaled
+ * constructor arguments *)
+ type expr =
+ [ `Var of string
+ | `Lam of <var:string; body:expr>
+ | `App of <func:expr; arg:expr>
+ | `Let of <var:string; rhs:expr; cont:expr> ]
+
+ type value =
+ [ `Lam of <var:string; body:expr; env:(string*value) list> ]
+
+ let rec eq = function
+ | `Var x, `Var y -> x = y
+ | `Lam {| var=vl; body=bl |}, `Lam {| var=vr; body=br |} -> vl = vr && eq (bl, br)
+ | `App {| func=fl; arg=al |}, `App {| func=fr; arg=ar |} -> eq (fl, fr) && eq (al, ar)
+ | `Let {| var=vl; rhs=rl; cont=kl |}, `Let {| var=vr; rhs=rr; cont=kr |} ->
+ vl = vr && eq (rl, rr) && eq (kl, kr)
+ | _ -> false
+
+ let eq_test =
+ test
+ (lazy
+ (assert
+ (not (eq (`Lam {| var = "x";
+ body = `App {| func = `Lam {| var = "y"; body = `Var "y" |};
+ arg = `Lam {| var = "z"; body = `Var "z" |} |} |},
+ `Lam {| var = "x";
+ body = `App {| func = `Lam {| var = "y"; body = `Var "y" |};
+ arg = `Lam {| var = "z"; body = `Var "x" |} |} |})))))
+
+ (* Or-bindings and object patterns *)
+ let rec count_lambdas = function
+ | `Lam {| body |} -> 1 + count_lambdas body
+ | `App {| func=e1; arg=e2 |}
+ | `Let {| rhs =e1; cont=e2 |} -> count_lambdas e1 + count_lambdas e2
+ | `Var _ -> 0
+
+ let plus =
+ `Lam {| var = "m";
+ body =
+ `Lam {| var = "n";
+ body =
+ `Lam {| var = "f";
+ body =
+ `Lam {| var = "x";
+ body =
+ `App {| func =
+ `App {| func = `Var "m";
+ arg = `Var "f" |};
+ arg =
+ `App {| func = `App {| func = `Var "n";
+ arg = `Var "f" |};
+ arg = `Var "x" |} |} |} |} |} |}
+ let count_test =
+ test
+ (lazy
+ (assert
+ (count_lambdas plus = 4)))
+
+ let let_binding_test_1 =
+ test
+ (lazy
+ (assert
+ let {| x; y |} = {| x = 3; y = "four" |} in
+ (y, x) = ("four", 3)))
+
+ let let_binding_test =
+ test
+ (lazy
+ (assert
+ let ({| x; y |}, _) = ({| x = 3; y = "four" |}, ()) in
+ (y, x) = ("four", 3)))
+end
+
+let _ =
+ let module T = Tests(struct end) in
+ if !passed then print_endline "object tests succeeded"
44 applications/object/pa_object.ml
@@ -0,0 +1,44 @@
+(*pp camlp4of -loc loc -I ../.. traverse.cmo patterns.cmo *)
+
+open Camlp4.PreCast
+
+let rec fields : Ast.patt -> (string * Ast.patt) list = function
+ | <:patt< $m$ ; $o$ >> -> fields m @ fields o
+ | <:patt< $lid:l$ = $p$ >> -> [l,p]
+ | _ -> assert false
+
+(* Somewhat based on Jacques Garrigue's pa_oo.ml *)
+EXTEND Syntax.Gram
+ GLOBAL: Syntax.patt Syntax.expr;
+
+ Syntax.patt: LEVEL "simple"
+ [["{|"; p = LIST1 method_patt SEP ";"; "|}" ->
+ let l = List.fold_left (fun l r -> <:patt< $l$ ; $r$ >>) (List.hd p) (List.tl p) in
+ <:patt< $uid:"object"$ $l$ >> ]];
+
+ method_patt:
+ [[ l = Syntax.label -> <:patt< $lid:l$ = $lid:l$ >>
+ | l = Syntax.label; "="; p = Syntax.patt -> <:patt< $lid:l$ = $p$ >> ]];
+
+ (* For convenience we provide a more concise syntax for constructing
+ objects *)
+ Syntax.expr: LEVEL "simple"
+ [[ "{|"; cf = LIST1 method_expr SEP ";"; "|}" -> <:expr< object $list:cf$ end >> ]];
+
+ method_expr:
+ [[ `LIDENT l -> <:class_str_item< method $l$ = $lid:l$ >>
+ | `LIDENT l; "="; e = Syntax.expr LEVEL "top" -> <:class_str_item< val $l$ = $e$ method $l$ = $lid:l$ >> ]];
+END
+
+object
+ inherit Patterns.extension
+ method translate v = function
+ | <:patt@loc< $uid:"object"$ $p$ >> ->
+ Some
+ (List.fold_right
+ (fun (l, p) (e, p') -> <:expr< ($v$ # $lid:l$, $e$) >>, <:patt< ($p$ , $p'$) >>)
+ (fields p)
+ (<:expr< () >>, <:patt< () >>))
+ | _ -> None
+end
+
452 patterns.ml
@@ -0,0 +1,452 @@
+(*pp camlp4of -loc loc *)
+(* Copyright 2008, Jeremy Yallop: see the file COPYING for details. *)
+
+open Camlp4.PreCast
+open Syntax
+open Traverse
+
+module Utils =
+struct
+ let fatal_error loc msg =
+ Syntax.print_warning loc msg;
+ exit 1
+
+ let fresh_name : unit -> string =
+ let counter = ref 0 in
+ fun () ->
+ incr counter;
+ Printf.sprintf "__patterns_%d" !counter
+
+ let rec split_match : Ast.match_case -> (Ast.patt * Ast.expr option * Ast.expr) list = function
+ | <:match_case< $l$ | $r$ >> -> split_match l @ split_match r
+ | <:match_case< >> -> []
+ | <:match_case< $p$ -> $e$ >> -> [p, None, e]
+ | <:match_case< $p$ when $g$ -> $e$ >> -> [p, Some g, e]
+ | _ -> assert false
+
+ let rec join_match loc : (Ast.patt * Ast.expr option * Ast.expr) list -> Ast.match_case = function
+ | [] -> <:match_case< >>
+ | (p, Some g, e) :: ms -> <:match_case< $p$ when $g$ -> $e$ | $join_match loc ms$ >>
+ | (p, None, e) :: ms -> <:match_case< $p$ -> $e$ | $join_match loc ms$ >>
+
+ let split_ors predicate loc (p : Ast.patt) : Ast.patt list =
+ let rec split pat (return : Ast.patt -> Ast.patt list) : Ast.patt list = match pat with
+ (* only need to handle cases with sub-patterns *)
+ | <:patt< $p$ | $q$ >> when predicate p || predicate q -> split p return @ split q return
+ | <:patt< $p$ | $q$ >> -> split p (fun p -> split q (fun q -> return (<:patt< $p$ | $q$ >>)))
+ | Ast.PaApp (loc, p, q) -> split p (fun p -> split q (fun q -> return (Ast.PaApp (loc, p, q))))
+ | <:patt< [| $p$ |] >> -> split p (fun p -> return (<:patt< [| $p$ |] >>))
+ | <:patt< { $p$ } >> -> split p (fun p -> return (<:patt< { $p$ } >>))
+ | <:patt< $p$ as $q$ >> -> split p (fun p -> return (<:patt< $p$ as $q$ >>))
+ (* | <:patt< $p$, $q$ >> -> split p (fun p -> split q (fun q -> return (<:patt< $p$, $q$ >>)))*)
+ | Ast.PaCom (loc, p, q) -> split p (fun p -> split q (fun q -> return (Ast.PaCom (loc, p, q))))
+ | Ast.PaTup (loc, p) -> split p (fun p -> return (Ast.PaTup (loc, p)))
+ | <:patt< $p$; $q$ >> -> split p (fun p -> split q (fun q -> return (<:patt< $p$; $q$ >>)))
+ | <:patt< $l$ = $p$ >> -> split p (fun p -> return (<:patt< $l$ = $p$ >>))
+ | <:patt< ($p$ : $t$) >> -> split p (fun p -> return (<:patt< ($p$ : $t$) >>))
+ (* nothing else (except labeled patterns) has sub-patterns *)
+ | pat -> return pat in
+ split p (fun p -> [p])
+
+ let join_bindings loc binds =
+ List.fold_right (fun l r -> <:binding< $l$ and $r$ >>) binds <:binding< >>
+end
+
+let expanders = ref []
+
+class virtual extension =
+object (self)
+ initializer (expanders := (self :> extension) :: !expanders)
+
+ method translate : Ast.expr -> Ast.patt -> (Ast.expr * Ast.patt) option = assert false
+
+ method translate_full : Ast.patt -> (Ast.patt * Ast.expr * Ast.patt) option =
+ fun p ->
+ let lid = Utils.fresh_name () in
+ let loc = Ast.loc_of_patt p in
+ match self#translate <:expr< $lid:lid$ >> p with
+ | Some (e, p) -> Some (<:patt< $lid:lid$ >>, e, p)
+ | None -> None
+
+ method expands (p : Ast.patt) : bool =
+ match self#translate_full p with
+ | Some _ -> true
+ | None -> false
+end
+
+(*
+ Whether a pattern contains special patterns within or patterns.
+*)
+let has_specials_within_ors =
+ let is_special p = List.exists (fun expander -> expander#expands p) !expanders in
+object (self)
+ inherit Ast.fold as super
+ val special = false
+ val special_within_or = false
+
+ method special = special
+ method special_within_or = special_within_or
+
+ method patt = function
+ | p when is_special p -> {< special = true >}
+ | <:patt< $l$ | $r$ >> -> let l = self#patt l and r = self#patt r in
+ {< special_within_or = self#special_within_or || l#special || r#special >}
+ | p -> super#patt p
+end
+
+let patt_has_specials_within_ors p = (has_specials_within_ors#patt p)#special_within_or
+
+let parameter_name = "__patterns_arg"
+
+(*
+ For now, let's run the or-splitter as a filter before the expander
+ filter. This may turn out to be less than ideal, especially in the
+ case of special patterns which expand into or patterns containing
+ special patterns. Perhaps we should just disallow those.
+*)
+let or_split =
+ let die loc context =
+ Utils.fatal_error loc
+ ("Custom patterns are not allowed within or patterns in " ^ context) in
+object (self)
+ (* Split up or-patterns. If there's a guard, add an extra reference
+ to make sure that the guard is only run once.
+
+ match e with
+ | p1 when g1 -> e1
+ ...
+ | pn when gn -> en
+ ~>
+
+ let r1 = ref true in
+ ...
+ let rn = ref true in
+ match e with
+ | p1_1 when !r1 && (r1 := false; g1) -> e1
+ ...
+ | p1_m when !r1 && (r1 := false; g1) -> e1
+ ...
+
+ | pn_1 when !rn && (!rn = false; gn) -> en
+ ...
+ | pn_m when !rn && (!rn = false; gn) -> en
+
+
+ where pi_1 ... pi_m are the patterns resulting from expanding
+ or-patterns in pi.
+ *)
+
+ inherit fold_map as super
+
+ val binds = []
+ method binds = binds
+ method fresh = {< binds = [] >}
+
+ method expr =
+ let fresh = self#fresh in function
+ | <:expr@loc< object ($p$) $csi$ end >> when patt_has_specials_within_ors p ->
+ die loc "self bindings"
+ | <:expr@loc< try $e$ with $matches$ >> ->
+ let _, e = self#expr e in
+ let m, matches = self#match_case matches in
+ begin match m#binds with
+ | [] -> m, <:expr< try $e$ with $matches$ >>
+ | b -> fresh, <:expr< let $Utils.join_bindings loc b$ in try $e$ with $matches$ >>
+ end
+ | <:expr@loc< match $e$ with $matches$ >> ->
+ let _, e = self#expr e in
+ let m, matches = self#match_case matches in
+ begin match m#binds with
+ | [] -> m, <:expr< match $e$ with $matches$ >>
+ | b -> fresh, <:expr< let $Utils.join_bindings loc b$ in match $e$ with $matches$ >>
+ end
+ | <:expr@loc< function $matches$ >> ->
+ let m, matches = self#match_case matches in
+ begin match m#binds with
+ | [] -> m, <:expr< function $matches$ >>
+ | b -> self#fresh, <:expr< fun $lid:parameter_name$ ->
+ let $Utils.join_bindings loc b$ in
+ match $lid:parameter_name$ with $matches$ >>
+ end
+ | e -> super#expr e
+
+ method binding = function
+ | <:binding@loc< $p$ = $e$ >> when patt_has_specials_within_ors p ->
+ die loc "let bindings"
+ | b -> super#binding b
+
+ method match_case = function
+ | <:match_case@loc< $p$ when $g$ -> $e$ >> when patt_has_specials_within_ors p ->
+ let _, p = self#patt p in
+ let _, g = self#expr g in
+ let _, e = self#expr e in
+ begin match Utils.split_ors (fun p -> (has_specials_within_ors#patt p)#special) loc p, g with
+ | [], _ -> assert false
+ | [p], _ -> self, <:match_case@loc< $p$ when $g$ -> $e$ >>
+ | ps, <:expr< >> -> let ms = List.map (fun p -> <:match_case< $p$ -> $e$ >>) ps in
+ self, <:match_case< $list:ms$ >>
+ | ps, _ -> let name = Utils.fresh_name () in
+ let bind = <:binding< $lid:name$ = ref true >> in
+ let ms = List.map (fun p -> <:match_case< $p$ when (! $lid:name$ && ($lid:name$ := false; $g$)) -> $e$ >>) ps in
+ {< binds = bind :: binds >}, <:match_case< $list:ms$ >>
+ end
+ | m -> super#match_case m
+ method class_expr = function
+ | <:class_expr@loc< fun $p$ -> $ce$ >> when patt_has_specials_within_ors p ->
+ die loc "class-function bindings"
+ | <:class_expr@loc< object ($p$) $csi$ end >> when patt_has_specials_within_ors p ->
+ die loc "self bindings"
+ | c -> super#class_expr c