camlspotter avatar camlspotter committed 3353bf6

update

Comments (0)

Files changed (15)

-v.2.1.1
+v.2.1.1 (not released yet)
         - Renamed Stream by Pstream, to avoid the name clash with OCaml's Stream.
 v.2.1.0
 	- bug fixes
 * omake
 * sexplib 108.07.00
 
-The followings are required for building an ocaml parser using Planck
-
-* pa_monad_custom -- from http://bitbucket.org/camlspotter/pa_monad_custom/
-* ocaml 3.12.0 source code tree, compiled, and its toplevel directory is symlinked as `ocaml/ocaml' in this directory. I mean, cat ocaml/ocaml/VERSION must show you a text "3.12.1...".
-* (optional) lablgtk-2.14.2 source code for test parsing of oo codes. Its toplevel directory must be symlinked as `lablgtk-2.14.2' in this directory.
-
-If you are not interesting in preparing these things for the ocaml parser, edit around the last line of OMakefile.
-
 Install
 =======
 
 1. set PREFIX env var
 2. yes no | omake --install
 3. omake
-
-Modules
-=======
-
-* Result	: Result monad. Haskell's Either monad, but I hate the names.
-
-* Position	: Module for locations like bytes, lines and columns of inputs.
-
-* Lazylist	: Used for implementing parse target streams
-
-* Stream_intf	: Module type declarations for streams.
-* Stream	: Basic stream operations
-* Sstring	: Stream of strings (Not chars) 
-* Sbuffer	: Stream specialized for chars with efficient buffering
-* Smemo		: Stream with memoization by stream positions
-
-* Planck_intf	: Module type declarations for parser combinators
-* Pbase		: Base parser combinators
-* Pchar         : Parser combinators specialized for char stream
-* Pbuffer	: Parser combinators specialized for Sbuffer
-
-* Op_prec	: Operator precedence resolution
-
-Test
-====
-
-* expr          : This is a small calculator. It contains:
-                  
-                    * binary operator precedence resolution
-                    * manual removal of left recursion rules
-
-                  To test its parsing and calculation correctness, cd test; omake test .
 
 Tiny Parsec in OCaml. 
 
-Version 0.1.0. 
-
 Requirements
 ============
 
 
 # BYTE_ENABLED= true
 
-OCAMLINCLUDES += ../lib ocaml/utils ocaml/parsing
+OCAMLINCLUDES += ../lib
 
 OCAMLFLAGS    += -annot -w Ae
 OCAMLCFLAGS   +=
 OCAMLPACKS[]= 
     spotlib
     sexplib
+    ocamlgraph
+    compiler-libs.common
 
 # camlp4o ../pa_monad_custom/pa_monad.cmo ../pa_bind_inline/pa_bind_inline.cmo lex.ml
 %.out.ml: %.ml ../../pa_monad_custom/pa_monad.cmo ../pa_bind_inline/pa_bind_inline.cmo
 # OCAMLDEPFLAGS= -syntax camlp4o -package sexplib.syntax,monad
 # OCAMLPPFLAGS= -syntax camlp4o -package sexplib.syntax,monad
 
-FILES[] = 
+################ plpautoconv, a tool to partially auto-generate plparser.ml
+
+FILES_plpautoconv[] = 
    ../lib/planck
    input
    token
    lex
    yacc
    ocamlyacc
-   ocamlyacctest
+   plpautoconv
 
-# MyOCamlProgram(hamkl, $(FILES))
+NO_INSTALL=true
+MyOCamlProgram(plpautoconv, $(FILES_plpautoconv))
 
-FILES0[] =
+################################################################# lexer test
+
+FILES_lex[] =
    ../lib/planck
    input
    token
    lex
    lextest
 
-if $(file-exists ocaml/VERSION)
-   MyOCamlProgram(lexer, $(FILES0))
-   export
+MyOCamlProgram(lexer, $(FILES_lex))
 
-FILES1[] =
+############################################################# token stream test
+
+FILES_token[] =
    ../lib/planck
    input
    token
    lex
    tokentest
 
+MyOCamlProgram(token, $(FILES_token))
+export
+
+#X# FILES2[] =
+#X#    ../lib/planck
+#X#    input
+#X#    token
+#X#    lex
+#X#    ocaml/utils/misc
+#X#    ocaml/utils/config
+#X#    ocaml/utils/clflags
+#X#    ocaml/utils/warnings
+#X#    ocaml/utils/terminfo
+#X# 
+#X# #   ocaml/parsing/linenum
+#X#    ocaml/parsing/location
+#X#    ocaml/parsing/syntaxerr
+#X#    ocaml/parsing/lexer
+#X#    ocaml/parsing/longident
+#X#    ocaml/parsing/parser
+#X#    ocaml/parsing/parse
+#X# 
+#X#    xlocation
+#X#    xparsetree
+#X#    plphelper
+#X#    plparser
+#X#    parsertest
+#X# 
+#X# if $(file-exists ocaml/VERSION)
+#X#    MyOCamlProgram(parser, $(FILES2))
+#X#    export
+#X# 
+#X# FILES3[] =
+#X#    ../lib/planck
+#X#    input
+#X#    token
+#X#    lex
+#X# 
+#X#    ocaml/utils/misc
+#X#    ocaml/utils/config
+#X#    ocaml/utils/clflags
+#X#    ocaml/utils/warnings
+#X#    ocaml/utils/terminfo
+#X# 
+#X# #   ocaml/parsing/linenum
+#X#    ocaml/parsing/location
+#X#    ocaml/parsing/syntaxerr
+#X#    ocaml/parsing/lexer
+#X#    ocaml/parsing/longident
+#X#    ocaml/parsing/parser
+#X#    ocaml/parsing/parse
+#X# 
+#X#    lexertest
+#X# 
+#X# if $(file-exists ocaml/VERSION)
+#X#    MyOCamlProgram(lexertest, $(FILES3))
+#X#    export
+#X# 
 if $(file-exists ocaml/VERSION)
-   MyOCamlProgram(token, $(FILES1))
-   export
-
-FILES2[] =
-   ../lib/planck
-   input
-   token
-   lex
-   ocaml/utils/misc
-   ocaml/utils/config
-   ocaml/utils/clflags
-   ocaml/utils/warnings
-   ocaml/utils/terminfo
-
-#   ocaml/parsing/linenum
-   ocaml/parsing/location
-   ocaml/parsing/syntaxerr
-   ocaml/parsing/lexer
-   ocaml/parsing/longident
-   ocaml/parsing/parser
-   ocaml/parsing/parse
-
-   xlocation
-   xparsetree
-   plphelper
-   plparser
-   parsertest
-
-if $(file-exists ocaml/VERSION)
-   MyOCamlProgram(parser, $(FILES2))
-   export
-
-FILES3[] =
-   ../lib/planck
-   input
-   token
-   lex
-
-   ocaml/utils/misc
-   ocaml/utils/config
-   ocaml/utils/clflags
-   ocaml/utils/warnings
-   ocaml/utils/terminfo
-
-#   ocaml/parsing/linenum
-   ocaml/parsing/location
-   ocaml/parsing/syntaxerr
-   ocaml/parsing/lexer
-   ocaml/parsing/longident
-   ocaml/parsing/parser
-   ocaml/parsing/parse
-
-   lexertest
-
-if $(file-exists ocaml/VERSION)
-   MyOCamlProgram(lexertest, $(FILES3))
-   export
-
-plparser.auto.ml: hamkl.opt ../ocaml/parsing/parser.mly
-    ./hamkl.opt ../ocaml/parsing/parser.mly > $@
-
-OCAML_LIBS +=
-OCAML_CLIBS +=
-OCAML_OTHER_LIBS +=
-OCAML_LIB_FLAGS +=
-
-.PHONY: test test2
-
-if $(file-exists ocaml/VERSION)
-  test: parser
-      $(shell bash -c 'for i in test*.ml test*.mli; do ./parser $$i; done') 
-
-  test2: parser
-      $(shell bash -c 'for i in test*.ml test*.mli; do ./lexertest $$i; done') 
-
-  diff.txt: plparser.auto.ml
-      diff -c plparser.auto.ml plparser.ml  > diff.txt
-  export
+    plparser.auto.ml: plpautoconv ocaml/parsing/parser.mly
+        ./plpautoconv ocaml/parsing/parser.mly > $@
+#X# 
+#X# OCAML_LIBS +=
+#X# OCAML_CLIBS +=
+#X# OCAML_OTHER_LIBS +=
+#X# OCAML_LIB_FLAGS +=
+#X# 
+#X# .PHONY: test test2
+#X# 
+#X# if $(file-exists ocaml/VERSION)
+#X#   test: parser
+#X#       $(shell bash -c 'for i in test*.ml test*.mli; do ./parser $$i; done') 
+#X# 
+#X#   test2: parser
+#X#       $(shell bash -c 'for i in test*.ml test*.mli; do ./lexertest $$i; done') 
+#X# 
+#X#   diff.txt: plparser.auto.ml
+#X#       diff -c plparser.auto.ml plparser.ml  > diff.txt
+#X#   export

ocaml/OMyMakefile

-# ==========================
-# OMyMakefile
-# ==========================
-# Useful functions to build OCaml projects
-
-#| A flag to tell that we can use OMyMakefile functions
-WithOMy=true
-
-.PHONY: all install uninstall clean
-
-# Directories
-# =====================================================================
-
-#| The build root directory  
-BIG_ROOT=$(dir .)
-
-#| The prefix. Equal to the PREFIX environment variable
-try
-  PREFIX=$(getenv PREFIX)
-default
-  eprintln(Specify PREFIX environment variable.)
-  exit 1 
-
-# Installation mark files
-# =======================================================================
-
-#| To enable the installation mark files, you must define INSTALLED path variable
-# for the mark file directory like INSTALLED=$(BIG_ROOT)/installed and make sure
-# the directory $(INSTALLED) exists. This preparation must be done outside of 
-# this OMyMakefile.
-
-#|Returns the installation mark files of $(packs)
-Installed(packs) = 
-  if $(defined INSTALLED)
-      return $(addprefix $(INSTALLED)/, $(packs))
-  else
-      return $(array)
-
-#|Create md5 sum file of $(targets)
-CreateCheckSum(pack, targets)=
-    chan=$(fopen $(pack), w)
-    fprintln($(chan), $(string $(targets)))
-    fprintln($(chan), $(string $(digest $(targets))))
-    close($(chan))
-
-#|Create $(Installed $(pack)) file from the digests of $(targets)
-CreateInstalled(pack, targets)=
-    if $(defined INSTALLED)
-        println(dump md5 $(INSTALLED)/$(pack))
-        CreateCheckSum($(INSTALLED)/$(pack), $(targets))
-
-# Misc tools
-# ======================================================================
-
-#|ditto.
-mkdir_if_not_exists(dir) =
-  if $(not $(test -e $(dir))):
-    mkdir $(dir) 
-  return
-
-# OCamlFind
-# ========================================================================
-
-#|OMy requires OCamlFind! Do not ask me how to use OMy without OCamlFind. Please.
-USE_OCAMLFIND = true
-OCAMLFIND_DESTDIR=$(PREFIX)/lib/ocaml/site-lib
-
-# OCaml -where
-# ========================================================================
-
-#|Path to the OCaml library directory
-OCAML_WHERE = $(shell ocamlc -where)
-
-#|Preinstalled libraries which are always available for normal ocaml.
-#
-# You may want to add the required packages which are built and installed out of OMy framework:
-#
-#::
-#
-#   include OMyMakefile
-#   
-#   OCAML_PREINSTALLED_PACKS += llvm # llvm has been installed already, independently
-#   
-#   Subdirs()
-#
-# It includes "findlib" by default. If you want to build findlib in OMy framework, you have to remove it from the list.
-OCAML_PREINSTALLED_PACKS[]= bigarray camlp4 dbm dynlink graphics num num-top stdlib str threads unix findlib
-
-# byte/nat
-NATIVE_ENABLED = $(OCAMLOPT_EXISTS)
-#|If set false in a project directory, byte compilation is disabled there.
-BYTE_ENABLED = true
-
-######################### Compiler
-OCAMLPACKAGEFLAGS=
-
-# Why we need "public." ?
-public.OCamlC() =
-    value $(OCAMLFIND) $(OCAMLC) $(OCAMLPACKAGEFLAGS) $(LAZY_OCAMLFINDFLAGS) $(PREFIXED_OCAMLPACKS) $(OCAMLFLAGS)\
-              $(OCAMLCFLAGS) $(OCAMLPPFLAGS) $(PREFIXED_OCAMLINCLUDES)
-
-public.OCamlOpt() =
-    value $(OCAMLFIND) $(OCAMLOPT) $(OCAMLPACKAGEFLAGS) $(LAZY_OCAMLFINDFLAGS) $(PREFIXED_OCAMLPACKS) $(OCAMLFLAGS)\
-              $(OCAMLOPTFLAGS) $(OCAMLPPFLAGS) $(PREFIXED_OCAMLINCLUDES)
-
-# Spot files (OCamlSpotter)
-# ==================================================================
-
-#| OCAML_SPOT is true if the compiler supports ocamlspot
-OCAML_SPOT = false
-match $(string $(shell ocamlc -version)) # We cannot use OCamlC since there may not be ocamlfind
-case $"ocamlspot"
-  OCAML_SPOT = true 
-  export
-
-#| Define OCAML_ANNOT so that custom ocamlc/ocamlopt automatically create spot/spit/annot files, even without -annot option.
-setenv(OCAML_ANNOT, 1)
-
-# Additional implicit rules by file extensions
-
-# annot, spot, spit files
-%.annot %.spot: %.ml %.cmi
-	$(OCamlC) -c $<
-
-%.spit: %.mli 
-	$(OCamlC) -c $<
-
-# Packages
-# =========================================================
-
-#| OCaml packages required for compilation. MyCaml* functions automatically add necessary dependencies over packages in $(OCAMLPACKS).
-# 
-# .. note:: They are also required for dependency analysis.
-public.OCAMLPACKS[]=
-
-#| CamlP4 syntax extension packages required for parsing. MyCaml* functions automatically add necessary dependencies over packages in $(CAMLP4PACKS).
-public.CAMLP4PACKS[]=
-
-# Dependencies
-# =========================================================================
-
-#|Returns packages managed by OMy framework
-OMyManagedPackages(packages) =
-   return $(set-diff $(packages), $(OCAML_PREINSTALLED_PACKS))
-
-#|Add dependencies of any build activity of this directory over $(files).
-#
-# .. note:: These functions introduce implicit rules: *you may need to export it, if you use this function in a local context.*
-RequireFiles(files) =
-    .SCANNER: scan-%: $(files)
-    % : $(files)
-    export
-
-#|Add dependencies of any build activity over $(packages).
-#
-# .. note:: These functions introduce implicit rules: *you may need to export it, if you use this function in a local context.*
-RequirePackages(packages) =
-    RequireFiles($(OMyManagedPackages $(packages)))
-    export
-
-#|Add dependencies of any build activity of this directory over $(targets) and their dependencies
-# Creates an intermidiate md5 memo dependencies.md5
-#
-# .. note:: These functions introduce implicit rules: *you may need to export it, if you use this function in a local context.*
-RequireBuild(targets) =
-    dependencies.md5: $(targets)
-        CreateCheckSum($@, $(sequence-sort $(compare), $(dependencies-all $(targets))))
-    RequireFiles(dependencies.md5)
-    export
-
-#|Add dependencies of OCaml compiled files (cmx, cmo, etc.) over $(packages).
-# $(packages) listed in OCAML_PREINSTALLED_PACKS are ignored.
-#
-# .. note:: These functions introduce implicit rules: *you may need to export it, if you use this function in a local context.*
-#
-# .. note:: Usually you do not need to call this function. Use OCAMLPACKS variable instead. 
-OCamlRequirePackages(packages) =
-    packages += findlib # Yes we use findlib
-    required_packs = $(OMyManagedPackages $(packages))
-    %.cmx %.cmo %.cmi %.cma %.cmxa %.annot %.spot %.spit : $(Installed $(required_packs))
-    export
-
-#|Add dependencies of OCaml dependency analysis and build over $(packages).
-# Use this for adding dependencies for CamlP4 extensions.
-# $(packages) listed in OCAML_PREINSTALLED_PACKS are ignored.
-#
-# .. note:: These functions introduce implicit rules: *you may need to export it, if you use this function in a local context.*
-#
-# .. note:: Usually you do not need to call this function. Use CAML4PACKS variable instead. 
-OCamlRequireCamlP4Packages(packages) =
-    packages += findlib # Yes we use findlib
-    required_packs = $(OMyManagedPackages $(packages))
-    .SCANNER: scan-ocaml-%: $(Installed $(required_packs))
-    %.cmx %.cmo %.cmi %.cma %.cmxa %.annot %.spot %.spit : $(Installed $(required_packs))
-    export
-
-#|``omake xxx.auto.mli`` generates .mli file from xxx.ml 
-%.auto.mli: %.ml
-	$(OCamlC) -i -c $< > $@
-
-# Build rules
-# ==========================================================
-
-# Extend the bundled OCamlPackage with .spot creation
-public.OCamlPackage(name, files) =
-   # XXX: JYH: these variables should be marked private in 0.9.9
-   protected.OFILES   = $(addsuffix $(EXT_OBJ), $(files))
-   protected.CMOFILES = $(addsuffix .cmo, $(files))
-   protected.CMXFILES = $(addsuffix .cmx, $(files))
-
-   protected.OBJ       = $(file $(name)$(EXT_OBJ))
-   protected.CMO       = $(file $(name).cmo)
-   protected.CMX       = $(file $(name).cmx)
-   protected.CMI       = $(file $(name).cmi)
-   protected.MLI       = $(file $(name).mli)
-
-   protected.BYTE_TARGETS   = $(CMO)
-   protected.NATIVE_TARGETS = $(CMX) $(OBJ)
-
-   if $(OCAML_SPOT)
-       if $(BYTE_ENABLED)
-          BYTE_TARGETS += $(file $(name).spot)
-          export
-       else
-          NATIVE_TARGETS += $(file $(name).spot)
-          export
-       export
-
-   protected.TARGETS = $(CMI)
-   if $(NATIVE_ENABLED)
-       TARGETS += $(NATIVE_TARGETS)
-       export
-
-   if $(BYTE_ENABLED)
-       TARGETS += $(BYTE_TARGETS)
-       export
-
-   #
-   # Link commands
-   #
-   protected.BYTE_DEPS = $(CMOFILES)
-   $(BYTE_TARGETS): $(CMOFILES)
-      section rule
-         if $(or $(NATIVE_ENABLED), $(target-exists $(MLI)))
-             BYTE_DEPS += $(CMI)
-             export
-         else
-             BYTE_TARGETS += $(CMI)
-             export
-         $(BYTE_TARGETS): $(BYTE_DEPS)
-            $(OCAMLFIND) $(OCAMLC) $(LAZY_OCAMLFINDFLAGS) $(PREFIXED_OCAMLPACKS) $(OCAMLFLAGS) \
-                $(OCAMLCFLAGS) $(OCAML_LIB_FLAGS) -pack -o $(CMO) $(OCamlLinkSort $(CMOFILES))
-
-   protected.NATIVE_DEPS = $(CMXFILES) $(OFILES)
-   $(NATIVE_TARGETS): $(NATIVE_DEPS)
-      section rule
-         if $(target-exists $(MLI))
-            NATIVE_DEPS += $(CMI)
-            export
-         else
-            NATIVE_TARGETS += $(CMI)
-            export
-         $(NATIVE_TARGETS): $(NATIVE_DEPS)
-            $(OCAMLFIND) $(OCAMLOPTLINK) $(LAZY_OCAMLFINDFLAGS) $(PREFIXED_OCAMLPACKS) $(OCAMLFLAGS) \
-                $(OCAMLOPTFLAGS) $(OCAML_LIB_FLAGS) -pack -o $(CMX) $(OCamlLinkSort $(CMXFILES))
-
-   $(CMI):
-      section rule
-         if $(target-exists $(MLI))
-            $(CMI): $(MLI) :scanner: scan-ocaml-$(name).mli
-                $(OCamlC) -c $<
-         elseif $(NATIVE_ENABLED)
-            $(NATIVE_TARGETS) $(CMI): $(NATIVE_DEPS)
-               $(OCAMLFIND) $(OCAMLOPTLINK) $(LAZY_OCAMLFINDFLAGS) $(PREFIXED_OCAMLPACKS) $(OCAMLFLAGS) \
-                   $(OCAMLOPTFLAGS) $(OCAML_LIB_FLAGS) -pack -o $(CMX) $(OCamlLinkSort $(CMXFILES))
-         else
-            $(BYTE_TARGETS) $(CMI): $(BYTE_DEPS)
-               $(OCAMLFIND) $(OCAMLC) $(LAZY_OCAMLFINDFLAGS) $(PREFIXED_OCAMLPACKS) $(OCAMLFLAGS) \
-                   $(OCAMLCFLAGS) $(OCAML_LIB_FLAGS) -pack -o $(CMO) $(OCamlLinkSort $(CMOFILES))
-
-   return $(TARGETS)
-
-# Add implicit dependencies over the packages declared in OCAMLPACKS and CAMLP4PACKS
-# If this function is used in a local scope, you may want to export. 
-AddLocalOCamlPackageDependencies() =
-  # We make sure the required libraries are installed
-  OCamlRequirePackages($(OCAMLPACKS)) # must be exported!
-  OCamlRequireCamlP4Packages($(OCAMLPACKS) $(CAMLP4PACKS))
-  export
-
-#| Add a rule for OCaml package $(library_name).cmo, $(library_name).cmx and etc.
-#     library_name
-#         target package name
-#     files
-#         ML module names (without .ml)
-#     cmodules
-#         C source files (without .c)
-#     linkopts
-#         C library link option (without OCaml -cclib options)    
-#
-#  Example::
-#
-#      MyOCamlPackage(foo, alpha beta, $(EMPTY), $(EMPTY))
-#
-#  Todo: external C library
-MyOCamlPackage(library_name, files, cmodules, linkopts) =
-  AddLocalOCamlPackageDependencies()
-  export # The above thing is local: need to be exported
-
-  CSTUBS=$(addsuffix .o,$(cmodules))
-  CMOS=$(addsuffix .cmo,$(library_name))
-  CMXS=$(addsuffix .cmx,$(library_name))
-  CMA=$(library_name).cma
-  CMXA=$(library_name).cmxa
-
-  CSTUBLIBRARIES=
-  if $(not $(equal $(cmodules), $(EMPTY)))
-      CSTUBLIBRARIES= dll$(library_name).so lib$(library_name).a 
-      export
-
-  # CR jfuruse: I guess we do not need the following
-  # export # export the implicit rule above
-
-  .DEFAULT: $(library_name).cmo $(library_name).cmx $(library_name).cma $(library_name).cmxa
-
-  $(CMA) $(CMXA) $(library_name).a $(CSTUBLIBRARIES) : $(CSTUBS) $(CMOS) $(CMXS)
-      ocamlmklib -verbose -o $(library_name) $(CSTUBS) $(linkopts) $(CMOS) $(CMXS)
-
-  ## the followings are necessary for packing
-
-  OCAMLPACKAGEFLAGS += -for-pack $(capitalize $(library_name))
-  export OCAMLPACKAGEFLAGS
-
-  ## build rule
-
-  OCamlPackage($(library_name), $(files))
-
-  ## clean
-  AutoClean()
-  clean:
-	rm -f $(library_name).spot
-
-  ## install
-
-  # CR jfuruse: x.cmi is required if x.mli does not exist!
-  targets[]=META $(glob i, *.mli) $(library_name).cmi $(library_name).cmo $(library_name).cmx $(library_name).cma $(library_name).cmxa $(library_name).o
-
-  if $(OCAML_SPOT)
-    targets[]+= $(library_name).spot
-
-  $(BIG_ROOT)/installed/$(library_name): $(targets)
-	$(OCAMLFIND) remove $(library_name)
-	section:
-          $(OCAMLFIND) install $(library_name) $(targets)
-          CreateInstalled($(library_name), $(targets))
-
-  install: $(BIG_ROOT)/installed/$(library_name)
-
-  uninstall:
-	rm -f $(BIG_ROOT)/installed/$(library_name)
-	$(OCAMLFIND) remove $(library_name)
-
-############################################################## build ocaml exec
-
-#| Add a rule to build a program $(name)
-#      name
-#          Name of the program
-#      files
-#          OCaml module names (without .ml)
-MyOCamlProgram(name, files) =
-  AddLocalOCamlPackageDependencies()
-  export # The above thing is local: need to be exported
-
-  $(name).run $(name).opt: $(Installed $(OMyManagedPackages $(OCAMLPACKS)))
-
-  # CR jfuruse: forgot to add the deps over the packages!
-  .DEFAULT: $(OCamlProgram $(name), $(files))
-
-  # The following clean the files twice if MyOCamlPackge coexists,
-  # but who cases ?
-  AutoClean()
-
-#|  Add rules to build OCaml library $(name)
-#        name
-#            Name of the library
-#        files
-#            OCaml module name (without .ml)
-#
-#   .. note :: Probably you should use MyOCamlPackage
-MyOCamlLibrary(name, files) =
-  AddLocalOCamlPackageDependencies()
-  export # The above thing is local: need to be exported
-
-  # CR jfuruse: forgot to add the deps over the packages!
-  .DEFAULT: $(OCamlLibrary $(name), $(files))
-
-  # The following clean the files twice if MyOCamlPacakge coexists,
-  # but who cases ?
-  AutoClean()
-
-# Auto clean
-# ====================================================================
-
-#| Install clean command which cleans all the target files exists under the directory. Use with care.
-AutoClean()=
-    .PHONY: clean
-    clean:
-        rm -f $(filter-proper-targets $(ls R, .))
-
-# Subdir traversal
-# =====================================================================
-
-#| Recursively traverse the subdirs except $(dirs)
-Subdirs_except(dirs) =
-  # println(PWD: $(shell pwd))
-
-  # need to export since .SUBDIRS is evaluated in the global scope
-  export VISIT_SUBDIRS
-
-  sub_omakefiles = $(glob i, */OMakefile)
-  subdirs = $(sub_omakefiles.map $(dirname))
-
-  VISIT_SUBDIRS=$(set-diff $(subdirs), $(dirs))
-
-  # printing requires $(string ...) to convert arrays to strings
-  # println(SUBDIRS: $(string $(VISIT_SUBDIRS)))
-
-  # The rule
-  .SUBDIRS: $(VISIT_SUBDIRS)
-
-#| Recursively traverse all the subdirs
-Subdirs() =
-  Subdirs_except($(array))
-
-#| Recursively traverse the given subdirs $(dirs)
-Subdirs_only(dirs) =
- .SUBDIRS: $(dirs)
-
-# Dependency dot files for Graphviz
-# ======================================================================
-
-#| Add a rule for ``depend.dot`` for a dependency graph of OCaml files in the current directory
-Dot() =
-	depend.dot: $(ls *.ml *.mli)
-	    $(OCAMLFIND) ocamldoc -I +threads $(OCAMLPACKAGEFLAGS) $(LAZY_OCAMLFINDFLAGS) $(PREFIXED_OCAMLPACKS) $(OCAMLPPFLAGS) $(PREFIXED_OCAMLINCLUDES) -dot -dot-include-all -dot-reduce $+ -o $@
-
-
 open Planck
 
 module Stream = Schar
-(*
-struct
-  module Str = Stream.Make(struct
-    type elem = char
-    let show_elem = Printf.sprintf "%C"
-    let equal_elem (x : char) y = x = y
-    module Pos = Position.File
-    type attr = Sbuffer.buf
-    let default_attr = Sbuffer.default_buf
-    let position_of_attr = Sbuffer.position_of_buf
-  end)
-    
-  include Str
-  include Sbuffer.Extend(struct
-    include Str
-    let create_attr buf = buf
-    let buf st = attr st
-  end)
-end
-*)
 
 module Parser = struct
   module Base = Pbase.Make(Stream)
+(*
+
+  OCaml 3.12.1 compatible lexer
+
+*)
+
+open Spotlib.Spot
 open Planck
 open Printf
 open Token
   tokenp (function
     | '0' .. '7' -> true
     | _ -> false) 
-    <?> "octal"
+  <?> "octal"
 
 let hex_char : char t =
   tokenp (function
     | '0' .. '9' | 'A' .. 'F' | 'a' .. 'f' -> true
     | _ -> false)
-    <?> "hex"
+  <?> "hex"
 
 let char_or_underscores : 'a t -> string t = fun f ->
-  matched (perform
-             void f;
-             ?* (void f <|> underscore))
+  matched & perform
+    void f;
+    ?* (void f <|> underscore)
 
 let decimal_literal = char_or_underscores decimal_char
 
 let bin_literal : string t = perform
-  matched (perform
+  matched & perform
     zero;
-    void (one_of ['b'; 'B']);
-    void (char_or_underscores bin_char))
+    void & one_of ['b'; 'B'];
+    void & char_or_underscores bin_char
 
 let oct_literal : string t = perform
-  matched (perform
+  matched & perform
     zero;
-    void (one_of ['o'; 'O']);
-    void (char_or_underscores oct_char))
+    void & one_of ['o'; 'O'];
+    void & char_or_underscores oct_char
 
 let hex_literal : string t = perform
-  matched (perform
+  matched & perform
     zero;
-    void (one_of ['x'; 'X']);
-    void (char_or_underscores hex_char))
+    void & one_of ['x'; 'X'];
+    void & char_or_underscores hex_char
 
 let int_literal = (hex_literal <!> bin_literal <!> oct_literal) </> decimal_literal
 
   pos <-- position;
   s <-- int_literal;
   match try Some (int_of_string s) with Failure _ -> None with
-  | Some n -> return (INT n)
+  | Some n -> return & INT n
   | None -> error "int literal overflow" <?@> pos
 
 (*
 *)
 (* CR jfuruse: it is not regexp like. No backtracking... *)
 let float_literal = perform
-  matched (perform
-             void (char_or_underscores decimal_char);
-             option_ (perform
-                        token '.';
-                        option_ (void (char_or_underscores decimal_char)));
-             option_ (seq_ [ void (one_of ['e'; 'E']);
-                             option_ (void (one_of ['-'; '+']));
-                             void (char_or_underscores decimal_char) ]))
+  matched & perform
+    void (char_or_underscores decimal_char);
+    option_ & perform
+      token '.';
+      option_ & void & char_or_underscores decimal_char;
+    option_ & seq_ [ void & one_of ['e'; 'E'];
+                     option_ & void & one_of ['-'; '+'];
+                     void & char_or_underscores decimal_char ]
 
 let float = perform
   str <-- float_literal;
-  return (FLOAT (remove_underscores str))
+  return & FLOAT (remove_underscores str)
 
 let int32 = perform
   pos <-- position;
   s <-- int_literal;
   token 'l';
   try
-    return (INT32 (Int32.of_string s))
+    return & INT32 (Int32.of_string s)
   with Failure _ -> critical_error pos "int32 literal overflow"
 
 let int64 = perform
   s <-- int_literal;
   token 'L';
   try
-    return (INT64 (Int64.of_string s))
+    return & INT64 (Int64.of_string s)
   with Failure _ -> critical_error pos "int64 literal overflow"
 
 let nativeint = perform
   s <-- int_literal;
   token 'n';
   try
-    return (NATIVEINT (Nativeint.of_string s))
+    return & NATIVEINT (Nativeint.of_string s)
   with Failure _ -> critical_error pos "nativeint literal overflow"
 
-let newline = string "\r\n" <|> void (one_of ['\n'; '\r'])
-let blank = void (one_of [' '; '\009'; '\012'])
+let newline = string "\r\n" <|> (void & one_of ['\n'; '\r'])
+let blank = void & one_of [' '; '\009'; '\012']
 let lowercase = tokenp (function
   | 'a'..'z' | '\223'..'\246' | '\248'..'\255' | '_' -> true
   | _ -> false) <?> "lowercase char"
 let rec string_internal pos buf = 
   (perform
      token '"';
-     return (String.concat "" (List.rev buf)))
+     return & String.concat "" & List.rev buf)
   <|> (* '\\' case *)
       (perform
          pos <-- position;
             string_internal pos buf)
 
          <|> (perform
-               c <-- token_result (function
-                 | '\\' -> Result.Ok '\\'
-                 | '\'' -> Result.Ok '\''
-                 | '"' ->  Result.Ok '\"'
-                 | 'n' ->  Result.Ok '\n'
-                 | 't' ->  Result.Ok '\t'
-                 | 'b' ->  Result.Ok '\b'
-                 | 'r' ->  Result.Ok '\r'
-                 | ' ' ->  Result.Ok '\ '
-                 | _ -> Result.Error "Illegal escape char");
-               string_internal pos (String.make 1 c :: buf))
+                c <-- token_result (function
+                  | '\\' -> `Ok '\\'
+                  | '\'' -> `Ok '\''
+                  | '"' ->  `Ok '\"'
+                  | 'n' ->  `Ok '\n'
+                  | 't' ->  `Ok '\t'
+                  | 'b' ->  `Ok '\b'
+                  | 'r' ->  `Ok '\r'
+                  | ' ' ->  `Ok '\ '
+                  | _ -> `Error "Illegal escape char");
+                string_internal pos & String.make 1 c :: buf)
 
          <|> (perform
                 c1 <-- decimal_char;
                 c2 <-- decimal_char;
                 c3 <-- decimal_char;
-                c <-- char_for_decimal_code pos c1 c2 c3; (* CR jfuruse: error is never reported! *)
-                string_internal pos (String.make 1 c :: buf))
+                c  <-- char_for_decimal_code pos c1 c2 c3; (* CR jfuruse: error is never reported! *)
+                string_internal pos & String.make 1 c :: buf)
 
          (* Need backtrack since \3 is still a valid string (with a warning, though) *)
             
                 token 'x';
                 c1 <-- hex_char;
                 c2 <-- hex_char;
-                string_internal pos (String.make 1 (char_for_hexadecimal_code c1 c2) :: buf))
+                string_internal pos & (String.make 1 & char_for_hexadecimal_code c1 c2) :: buf)
 
          <!> (perform
                 c <-- take;
                 else begin
                   (* CR jfuruse: TODO *)
                   (* Location.prerr_warning loc Warnings.Illegal_backslash; *)
-                  string_internal pos (("\\" ^ String.make 1 c) :: buf)
+                  string_internal pos & ("\\" ^ String.make 1 c) :: buf
                 end) )
 
   <|> (perform
          s <-- matched newline;
-         string_internal pos (s :: buf))
+         string_internal pos & s :: buf)
 
   <|> (perform
          eos;
          critical_error pos "unterminated string")
 
   <|> (perform
-         s <-- matched (?+ (tokenp (function '"' | '\\' -> false | _ -> true)));
-         string_internal pos (s :: buf))
+         s <-- matched (?+ (tokenp & function '"' | '\\' -> false | _ -> true));
+         string_internal pos & s :: buf)
 
 (* string in OCaml but string is used in Planck *)
 let string_ = perform
   pos <-- position;
   token '"';
   s <-- string_internal pos [];
-  return (STRING s)
+  return & STRING s
 
 let char_internal = 
   (perform
      s <-- matched newline;
-     return (String.unsafe_get s 0) (* Funny that only the first char is used *))
+     return & String.unsafe_get s 0 (* Funny that only the first char is used *))
   <|> tokenp (function '\\' | '\'' | '\010' | '\013' -> false
                      | _ -> true)
   <|> (* '\\' case *)
 
          (perform
             c <-- one_of ['\\'; '\''; '"'; 'n'; 't'; 'b'; 'r'; ' '];
-            return (char_for_backslash c))
+            return & char_for_backslash c)
          <|> (perform 
                 c1 <-- decimal_char;
                 c2 <-- decimal_char;
                 token 'x';
                 c1 <--hex_char;
                 c2 <-- hex_char;
-                return (char_for_hexadecimal_code c1 c2)) 
+                return & char_for_hexadecimal_code c1 c2)
          <|> error "illegal escape")
 
 let char = perform
   token '\'';
   c <-- char_internal;
   token '\'';
-  return (CHAR c)
+  return & CHAR c
 
 let rec comment levs = perform
   pos <-- position;
   string "(*";
   \ in_comment := true;
-  comment_internal (pos :: levs)
+  comment_internal & pos :: levs
 
 and comment_internal levs = 
   comment levs
 
   <!> (perform
-         void (string "*)");
+         void & string "*)";
          (* CR jfuruse: it's side effective and may not work! *)
          match levs with
          | [] -> assert false (* since it has seen at least one beginning of comment! *)
   <!> (perform
          pos <-- position;
          token '"';
-         void (string_internal pos []); (* CR jfuruse; the result of string_internal is useless... 
+         void & string_internal pos []; (* CR jfuruse; the result of string_internal is useless... 
                                              concatenation could be outside of string_internal *)
          (* CR jfuruse: error handling is not done
             (EOS is done but no check of nice string in comment thing)
          comment_internal levs)
   <!> (perform
          token '\'';
-         void (tokenp (function
+         void & tokenp (function
            | '\\' | '\'' | '\010' | '\013' -> false
-           | _ -> true));
+           | _ -> true);
          token '\'';
          comment_internal levs)
   <!> (perform
          token '\'';
-         void (one_of ['\\'; '"'; '\''; 'n'; 't'; 'b'; 'r'; ' ']);
+         void & one_of ['\\'; '"'; '\''; 'n'; 't'; 'b'; 'r'; ' '];
          token '\'';
          comment_internal levs)
   <!> (perform
 
 let comment () = comment []
 
-let lident = matched (lowercase >>= fun _ -> ??* is_identchar)
-let uident = matched (uppercase >>= fun _ -> ??* is_identchar)
+let lident = matched & lowercase >>= fun _ -> ??* is_identchar
+let uident = matched & uppercase >>= fun _ -> ??* is_identchar
 
 (* token in OCaml. ``token'' is already used as Planck.token *) 
 let rec ocaml_token () : (Token.t * Str.Pos.t) t = perform
   <|> (* including case of '_' *)
       (lident >>= function
          | "_" -> return_with_pos UNDERSCORE
-         | s -> return_with_pos (try Hashtbl.find keyword_table s with Not_found -> LIDENT s))
+         | s -> return_with_pos & try Hashtbl.find keyword_table s with Not_found -> LIDENT s)
 
-  <|> (uident >>= fun s -> return_with_pos (UIDENT s))
+  <|> (uident >>= fun s -> return_with_pos & UIDENT s)
 
   <|> (* case of ~ *)
       ((perform
           name <-- lident;
           token ':';
           if Hashtbl.mem keyword_table name then error "keyword as label" (* CR jfuruse: not reported! *)
-          else return_with_pos (LABEL name))
+          else return_with_pos & LABEL name)
           
        <!> (matched (perform token '~'; ??* is_symbolchar) >>= function
               | "~" -> return_with_pos TILDE
-              | s -> return_with_pos (PREFIXOP s)))
+              | s -> return_with_pos & PREFIXOP s))
 
   <|> (* Include the case of '.' *)
       (with_pos (int </> float </> int32 </> int64 </> nativeint)
                token '*';
                return_with_pos STAR))
 
-       <!> (matched (token '*' >>= fun _ -> void (takeWhile  is_symbolchar)) >>= function
+       <!> (matched (token '*' >>= fun _ -> void & takeWhile is_symbolchar) >>= function
               | "*" -> return_with_pos STAR
               | s ->
-                  if String.unsafe_get s 1 = '*' then return_with_pos (INFIXOP4 s) (* ** case *)
-                  else return_with_pos (INFIXOP3 s)))
+                  if String.unsafe_get s 1 = '*' then return_with_pos & INFIXOP4 s (* ** case *)
+                  else return_with_pos & INFIXOP3 s))
 
   <|> (* case of '#' *)
       ((perform
           token '#';
           ??* (function ' ' | '\t' -> true | _ -> false);
-          num <-- matched (?+ decimal_char);
+          num <-- matched & ?+ decimal_char;
           ??* (function ' ' | '\t' -> true | _ -> false);
           name_opt <-- option (perform
-                                 token '"';
-                                 name <-- ??** (function '\010' | '\013' | '"' -> false
-                                                       | _ -> true);
-                                 token '"';
-                                 return name);
+            token '"';
+            name <-- ??** (function '\010' | '\013' | '"' -> false
+                                  | _ -> true);
+            token '"';
+            return name);
           ??* (function '\010' | '\013' -> false
                       | _ -> true);
           newline;
               name <-- lident;
               token ':';
               if Hashtbl.mem keyword_table name then error "keyword as label" (* CR jfuruse: not reported! *)
-              else return_with_pos (OPTLABEL name))
+              else return_with_pos & OPTLABEL name)
            (* We need the following backtrack for ?label (without :) *)
            <!> (??** is_symbolchar >>= 
                   function
                     | "" -> return_with_pos QUESTION
                     | "?" -> return_with_pos QUESTIONQUESTION
-                    | s -> return_with_pos (PREFIXOP ("?" ^ s)))))
+                    | s -> return_with_pos & PREFIXOP ("?" ^ s))))
 
   (* CR jfuruse: Should be extremely slow *)      
   <|> (
           function
             | "&&" -> return_with_pos AMPERAMPER
             | "&" -> return_with_pos AMPERSAND
-            | s -> return_with_pos (INFIXOP0 s))
+            | s -> return_with_pos & INFIXOP0 s)
 
        <|> (matched (token '-' >>= fun () -> ??* is_symbolchar) >>=
               function
                 | "-" ->  return_with_pos MINUS
                 | "-." ->  return_with_pos MINUSDOT
                 | "->" ->  return_with_pos MINUSGREATER
-                | s -> return_with_pos (INFIXOP2 s))
+                | s -> return_with_pos & INFIXOP2 s)
 
        <|> (token '`'  >>= fun () -> return_with_pos BACKQUOTE)
        <|> (token ','  >>= fun () -> return_with_pos COMMA)
               function
                 | "|" -> return_with_pos BAR
                 | "||" -> return_with_pos BARBAR
-                | s -> return_with_pos (INFIXOP0 s))
+                | s -> return_with_pos & INFIXOP0 s)
 
        <|> (string "::" >>= fun () -> return_with_pos COLONCOLON)
        <|> (string ":=" >>= fun () -> return_with_pos COLONEQUAL)
               function
                 | "<-" -> return_with_pos LESSMINUS
                 | "<" -> return_with_pos LESS
-                | s -> return_with_pos (INFIXOP0 s))
+                | s -> return_with_pos & INFIXOP0 s)
 
        <|> (matched (token '=' >>= fun () -> ??* is_symbolchar) >>=
               function
                 | "=" -> return_with_pos EQUAL
-                | s -> return_with_pos (INFIXOP0 s))
+                | s -> return_with_pos & INFIXOP0 s)
 
        <|> (string "[|" >>= fun () -> return_with_pos LBRACKETBAR)
        <|> (string "[<" >>= fun () -> return_with_pos LBRACKETLESS)
        <|> (matched (token '>' >>= fun () -> ??* is_symbolchar) >>=
               function
                 | ">" -> return_with_pos GREATER
-                | s -> return_with_pos (INFIXOP0 s))
+                | s -> return_with_pos & INFIXOP0 s)
 
        <|> (string "}"  >>= fun () -> return_with_pos RBRACE)
 
        <|> (matched (token '!' >>= fun () -> ??* is_symbolchar) >>=
               function
                 | "!" -> return_with_pos BANG
-                | "!=" -> return_with_pos (INFIXOP0 "!=")
-                | s -> return_with_pos (PREFIXOP s))
+                | "!=" -> return_with_pos & INFIXOP0 "!="
+                | s -> return_with_pos & PREFIXOP s)
 
        <|> (matched (token '+' >>= fun () -> ??* is_symbolchar) >>=
               function
                 | "+" -> return_with_pos PLUS
                 | "+." -> return_with_pos PLUSDOT
-                | s -> return_with_pos (INFIXOP2 s))
+                | s -> return_with_pos & INFIXOP2 s)
 
        <|> (matched (token '$' >>= fun () -> ??* is_symbolchar) 
-            >>= fun s -> return_with_pos (INFIXOP0 s))
+            >>= fun s -> return_with_pos & INFIXOP0 s)
        <|> (matched (one_of ['@'; '^'] >>= fun _ -> ??* is_symbolchar) 
-            >>= fun s -> return_with_pos (INFIXOP1 s))
+            >>= fun s -> return_with_pos & INFIXOP1 s)
        <|> (matched (one_of ['/'; '%'] >>= fun _ -> ??* is_symbolchar) 
-            >>= fun s -> return_with_pos (INFIXOP3 s)))
+            >>= fun s -> return_with_pos & INFIXOP3 s))
 
   <|> (take >>= fun c -> error (sprintf "ocaml lexer: illegal character %C" c) <?@> start_pos)
 
 
 let rec parse_and_print stream = 
   match Input.Parser.run (Input.Parser.eos_as_none Lex.ocaml_token) stream with
-  | Result.Ok (None, _) -> () (* EOS *)
-  | Result.Ok (Some (v, pos), stream') ->
+  | `Ok (None, _) -> () (* EOS *)
+  | `Ok (Some (v, pos), stream') ->
       let show t = Sexplib.Sexp.to_string_hum (Token.sexp_of_t t) in
       Format.eprintf "%s[%a]@." 
         (show v) 
         Position.Region.format pos;
       parse_and_print stream'
-  | Result.Error (pos, s) -> 
+  | `Error (pos, s) -> 
       Format.eprintf "%a: syntax error: %s@." Position.File.format pos s
 
 let _ = Arg.parse [] (fun x ->

ocaml/ocamlyacc.ml

+(*
+
+  Parser of OCamlYacc's .mly file
+
+  The parsing rule is more strict than what OCamlYacc accepts.
+  For example, this parser is not tolerable with:
+
+    * Extra ',' at the end of an action, 
+    * Missing ';' at the end of a rule.
+
+*)
+
+open Spotlib.Spot
 open Sexplib.Conv
-
-open Planck
 open Input.Parser
 
 (* No nested comment support *)
   string "%{";
   \ prerr_endline "header begin";
   let rec loop () = 
-    (perform ?* (ignore blank <!> Lex.comment ()); string "%}") 
+    (perform ?* (void blank <!> Lex.comment ()); string "%}") 
     <!> (Lex.ocaml_token >>= fun _v -> loop ()) 
   in
-  matched (loop ())
+  (* [matched ..] contains the last "%}" *) 
+  (* CR jfuruse: This is very stupid. We need a better way *)
+  (matched & loop ()) >>= return ** String.drop_postfix 2
+    
 
 module Decl = struct
 
     token '<'; 
     critical ((perform
                 ?* blank_or_c_comment;
-                s <-- matched (?+ (tokenp ((<>) '>')));
+                s <-- matched & ?+ (tokenp ((<>) '>'));
                 token '>';
                 return s) <?!> "error at type argument" )
 
           ?* blank_or_c_comment;
           typ <-- type_; ?* blank_or_c_comment;
           constrs <-- list_with_sep ~sep:(?+ blank_or_c_comment) constr;
-          return (Token (Some typ, constrs)))
+          return & Token (Some typ, constrs))
        <!> (perform
               ?+ blank_or_c_comment;
               constrs <-- list_with_sep ~sep:(?+ blank_or_c_comment) constr;
-              return (Token (None, constrs)))
+              return & Token (None, constrs))
     ) <?!> "%token")
 
   let type_ = perform
       ?* blank_or_c_comment;
       typ <-- type_; ?* blank_or_c_comment;
       symbols <-- list_with_sep ~sep:(?+ blank_or_c_comment) symbol;
-      return (Type (typ, symbols))
+      return & Type (typ, symbols)
     ) <?!> "%type") 
 
   let followed_by_symbols name c = perform
     critical ( ( perform
       ?+ blank_or_c_comment;
       symbols <-- list_with_sep ~sep:(?+ blank_or_c_comment) symbol;
-      return (c symbols)
+      return & c symbols
     ) <?!> ("%" ^ name) )
 
-  let start    = followed_by_symbols "start" (fun x -> Start x)
-  let left     = followed_by_symbols "left" (fun x -> Left x)
-  let right    = followed_by_symbols "right" (fun x -> Left x)
-  let nonassoc = followed_by_symbols "nonassoc" (fun x -> Nonassoc x)
+  let start    = followed_by_symbols "start" & fun x -> Start x
+  let left     = followed_by_symbols "left" & fun x -> Left x
+  let right    = followed_by_symbols "right" & fun x -> Left x
+  let nonassoc = followed_by_symbols "nonassoc" & fun x -> Nonassoc x
 
   let rec parse () = 
     decl_token <!> start <!> type_ <!> left <!> right <!> nonassoc
   let prec = perform
     token '%'; ?* blank_or_c_comment;
     string "prec"; 
-    critical ((perform
-      ?+ blank_or_c_comment;
-      Lex.lident
-    ) <?!> "%prec")
+    critical & (perform
+                  ?+ blank_or_c_comment;
+                  Lex.lident
+               ) <?!> "%prec"
 
 (* CR jfuruse: comparison is not simple I am afraid *)
 (*
         (perform ?+ blank; loop lev)
         <!> (perform
                token '{';
-               loop (lev+1))
+               loop & lev+1)
         <!> (perform
                if lev > 0 then begin perform 
                  token '}'; 
-                 loop (lev-1) 
+                 loop & lev-1
                end else token '}')
         <!> (perform
-               ignore Lex.ocaml_token;
+               void Lex.ocaml_token;
                loop lev)
       in
-      matched (loop 0)
+      (matched & loop 0) (* It contains '}' at the last *)
+      >>= return ** String.drop_postfix 1
     ) <?!> "ocaml code")
       
   let case = perform
       cases <-- list_with_sep ~optional_head:true ~sep:(perform ?* blank_or_c_comment; token '|'; ?* blank_or_c_comment) case;
       token ';'; ?* blank_or_c_comment;
       return { nonterminal = nonterminal; cases = cases; leftrec = `Unknown }
-    ) <?!> ("error at rule " ^ nonterminal) )
+    ) <?!> "error at rule " ^ nonterminal )
 end
 
       
   return (Yacc.create ~header:h ~decls ~rules ~trailer:tr)
 
 let parse st = try parse st with Critical_error (pos, mes) ->
-  Result.Error (pos, mes)
+  `Error (pos, mes)

ocaml/ocamlyacctest.ml

-open Spotlib.Spot
-open Planck
-
-open Ocamlyacc
-
-let rec parse stream = 
-  match Ocamlyacc.parse stream with
-  | Result.Ok (v, _stream') ->
-(*
-      let show t = Sexplib.Sexp.to_string_hum (Ocamlyacc.sexp_of_t t) in
-      prerr_endline (show v);
-*)
-      v
-  | Result.Error (pos, s) -> 
-      Format.eprintf "%a: syntax error: %s@." Position.File.format pos s;
-      raise Exit
-
-(* $ => "v_" *)
-let replace_dollar_n s =
-  let buf = Buffer.create (String.length s * 2) in
-  let nums = ref [] in
-  for i = 0 to String.length s - 1 do
-    match s.[i] with
-    | '$' -> 
-        let j = 
-          let rec scan j = 
-            if j = String.length s then j
-            else match s.[j] with
-            | '0'..'9' -> scan (j+1)
-            | _ -> j
-          in
-          scan (i+1)
-        in
-        nums := int_of_string (String.sub s (i+1) (j-i-1)) :: !nums;
-        Buffer.add_string buf "v_"
-    | c -> Buffer.add_char buf c
-  done;
-  Buffer.contents buf, !nums
-
-open Format
-
-let tokens = Hashtbl.create 107
-
-let symcode ppf case_is_leftrec used_ids i sym =
-  let subst ppf =
-    if List.mem i used_ids then fprintf ppf "v_%d <-- " i
-    else fprintf ppf "_v_%d <-- " i
-  in
-  try 
-    match sym with
-    | "error" -> fprintf ppf "take_ (* error *)"
-    | "EOF" -> fprintf ppf "eos"
-    | _ -> 
-        match Hashtbl.find tokens sym with
-        | None -> fprintf ppf "token %s" sym
-        | Some _ -> fprintf ppf "%tget_%s" subst sym
-  with
-  | Not_found -> 
-      fprintf ppf "%tself#%s %s" subst sym (if i = 1 && case_is_leftrec then "(* leftrec *)" else "")
-
-let process v = 
-  
-  Format.eprintf "#rules=%d@." (List.length v.Yacc.rules);
-  let sccs = Yacc.Rules.scc_list v.Yacc.rules in
-  List.iter (fun scc ->
-    match scc with
-    | [] -> ()
-    | [rule] when not (Yacc.Rule.is_direct_leftrec rule) -> ()
-    | _ ->
-        Format.eprintf "SCC %d: @[%a@]@."
-          (List.length scc)
-          (Format.list (fun ppf -> Format.fprintf ppf "@ ")
-             (fun ppf rule -> Format.fprintf ppf "%s" rule.Yacc.Rule.nonterminal)) scc
-    ) sccs;
-
-  printf "(* header *)
-open Parsing
-open Token
-open Token.Parser
-open Planck
-open Plphelper
-@.";
-
-  printf "%s@." v.Yacc.header;
-  printf "(* /header *)@.@.";
-
-  printf "(* declarations *)@.";
-  (list (fun _ppf -> ())
-       (fun ppf d -> 
-         match d with
-         | Yacc.Decl.Token (Some _, tkns) ->
-             List.iter (fun tkn ->
-               fprintf ppf "let get_%s = token_result (function (%s v) -> Result.Ok v | _ -> Result.Error \"expected %s\")@." tkn tkn tkn) tkns
-         | Yacc.Decl.Token (None, _tkns) -> ()
-         | _ -> fprintf ppf "(* %a *)@." (Sexplib.Sexp.pp_hum) (Yacc.Decl.sexp_of_t d);
-       )) stdout v.Yacc.decls;
-  printf "(* /declarations *)@.@.";
-
-  List.iter (function 
-    | Yacc.Decl.Token (typopt, tkns) -> 
-        List.iter (fun tkn -> Hashtbl.add tokens tkn typopt) tkns
-    | _ -> ()) v.Yacc.decls;
-
-  printf "(* rules *)@.@.";
-
-  printf "class rules = object (self)@.";
-
-  List.iter (fun r ->
-
-    match r.Yacc.Rule.leftrec with
-    | `Unknown -> assert false
-    | `NonRecursive ->
-
-        printf "  method %s = rule %S (fun () -> dummy@." r.Yacc.Rule.nonterminal r.Yacc.Rule.nonterminal;
-        List.iteri (fun i c ->
-          let ocaml_code, used_ids = replace_dollar_n c.Yacc.Rule.ocaml in
-          printf "    <!> case 1 \"%s_%d\" (fun () -> perform@." r.Yacc.Rule.nonterminal i;
-          printf "@.";
-          if c.Yacc.Rule.symbols = [] then printf "           (* empty *)@."
-          else
-            printf "           @[<v>%a@];@." 
-              (list (fun ppf -> fprintf ppf ";@,") (fun ppf (i,sym) -> symcode ppf false used_ids i sym))
-              (List.mapi (fun i sym -> (i+1,sym)) c.Yacc.Rule.symbols);
-          (match c.Yacc.Rule.prec with
-          | None -> ()
-          | Some sym -> printf "           (* %%prec %s *)@." sym);
-          printf "@.";
-          printf "           return (fun () -> %s))@.@." ocaml_code)
-          (List.sort Ocamlyacc.Rule.compare_case r.Yacc.Rule.cases);
-        printf "      )@.@.";
-             
-    | `Mutual _ | `NonMutual ->
-
-        printf "  method %s = leftrec %S self#%s_nonleftrec self#%s_leftrec@.@."
-          r.Yacc.Rule.nonterminal r.Yacc.Rule.nonterminal
-          r.Yacc.Rule.nonterminal r.Yacc.Rule.nonterminal;
-
-        printf "  method %s_nonleftrec = (dummy@." r.Yacc.Rule.nonterminal;
-        List.iteri (fun i c ->
-          let ocaml_code, used_ids = replace_dollar_n c.Yacc.Rule.ocaml in
-          printf "    <!> case 1 \"%s_nonleftrec_%d\" (fun () -> perform@." r.Yacc.Rule.nonterminal i;
-          printf "@.";
-          if c.Yacc.Rule.symbols = [] then printf "           (* empty *)@."
-          else
-            printf "           @[<v>%a@];@." 
-              (list (fun ppf -> fprintf ppf ";@,") (fun ppf (i,sym) -> symcode ppf false used_ids i sym))
-              (List.mapi (fun i sym -> (i+1,sym)) c.Yacc.Rule.symbols);
-          (match c.Yacc.Rule.prec with
-          | None -> ()
-          | Some sym -> printf "           (* %%prec %s *)@." sym);
-          printf "@.";
-          printf "           return (fun () -> %s))@.@." ocaml_code)
-          (List.sort Ocamlyacc.Rule.compare_case (List.filter (fun c -> c.Yacc.Rule.case_leftrec = `NonRecursive) r.Yacc.Rule.cases));
-        printf "      )@.@.";
-             
-        printf "  method %s_leftrec v_1 = (dummy@." r.Yacc.Rule.nonterminal;
-        List.iteri (fun i c ->
-          let ocaml_code, used_ids = replace_dollar_n c.Yacc.Rule.ocaml in
-          let is_case_mutual =
-            match c.Yacc.Rule.symbols with
-            | s::_ -> s <> r.Yacc.Rule.nonterminal
-            | _ -> false
-          in
-          if is_case_mutual then printf "(* MUTUAL LEFT REC @.";
-          printf "    <!> case 2 \"%s_leftrec_%d\" (fun () -> perform@." r.Yacc.Rule.nonterminal i;
-          printf "@.";
-          if is_case_mutual then begin
-            let symbols = c.Yacc.Rule.symbols in
-            if symbols = [] then printf "           (* empty *)@."
-            else
-              printf "           @[<v>%a@];@." 
-                (list (fun ppf -> fprintf ppf ";@,") (fun ppf (i,sym) -> symcode ppf false used_ids i sym))
-                (List.mapi (fun i sym -> (i+1,sym)) symbols);
-            (match c.Yacc.Rule.prec with
-            | None -> ()
-            | Some sym -> printf "           (* %%prec %s *)@." sym);
-            printf "@.";
-            printf "           return (fun () -> %s))@.@."
-              ocaml_code
-          end else begin
-            let symbols = List.tl c.Yacc.Rule.symbols in
-            if symbols = [] then printf "           (* empty *)@."
-            else
-              printf "           @[<v>%a@];@." 
-                (list (fun ppf -> fprintf ppf ";@,") (fun ppf (i,sym) -> symcode ppf false used_ids i sym))
-                (List.mapi (fun i sym -> (i+2,sym)) symbols);
-            (match c.Yacc.Rule.prec with
-            | None -> ()
-            | Some sym -> printf "           (* %%prec %s *)@." sym);
-            printf "@.";
-            printf "           return (fun () -> %s))@.@." 
-              ocaml_code
-          end;
-          if is_case_mutual then printf "*)@.")
-          (List.sort Ocamlyacc.Rule.compare_case (List.filter (fun c -> c.Yacc.Rule.case_leftrec <> `NonRecursive) r.Yacc.Rule.cases));
-        printf "      )@.@.";
-
-  ) v.Yacc.rules;
-
-  printf "end@.";
-    
-  printf "(* /rules *)@.@.";
-
-  printf "(* trailer *)@.%s@.(* /trailer *)@." v.Yacc.trailer
-
-let _ = Arg.parse [] (fun x ->
-  let ic = open_in x in
-  let stream = Input.Stream.from_chan ~filename:"" ic in
-  let v = parse stream in
-  close_in ic;
-  process v;
-  ) "ocamlyacctest files"
-

ocaml/plpautoconv.ml

+open Spotlib.Spot
+open Planck
+
+let parse stream = 
+  match Ocamlyacc.parse stream with
+  | `Ok (v, _stream') ->
+(*
+      let show t = Sexplib.Sexp.to_string_hum (Ocamlyacc.sexp_of_t t) in
+      prerr_endline (show v);
+*)
+      v
+  | `Error (pos, s) -> 
+      Format.eprintf "%a: syntax error: %s@." Position.File.format pos s;
+      raise Exit
+
+(* $ => "v_" *)
+let replace_dollar_n s =
+  let buf = Buffer.create & String.length s * 2 in
+  let nums = ref [] in
+  for i = 0 to String.length s - 1 do
+    match s.[i] with
+    | '$' -> 
+        let j = 
+          let rec scan j = 
+            if j = String.length s then j
+            else match s.[j] with
+            | '0'..'9' -> scan (j+1)
+            | _ -> j
+          in
+          scan (i+1)
+        in
+        nums := int_of_string (String.sub s (i+1) (j-i-1)) :: !nums;
+        Buffer.add_string buf "v_"
+    | c -> Buffer.add_char buf c
+  done;
+  Buffer.contents buf, !nums
+
+open Format
+
+let tokens = Hashtbl.create 107
+
+let symcode ppf case_is_leftrec used_ids i sym =
+  let subst ppf =
+    if List.mem i used_ids then fprintf ppf "v_%d <-- " i
+    else fprintf ppf "_v_%d <-- " i
+  in
+  try 
+    match sym with
+    | "error" -> fprintf ppf "take_ (* error *)"
+    | "EOF" -> fprintf ppf "eos"
+    | _ -> 
+        match Hashtbl.find tokens sym with
+        | None -> fprintf ppf "token %s" sym
+        | Some _ -> fprintf ppf "%tget_%s" subst sym
+  with
+  | Not_found -> 
+      fprintf ppf "%tself#%s %s" subst sym (if i = 1 && case_is_leftrec then "(* leftrec *)" else "")
+
+let process v = 
+  
+  Format.eprintf "#rules=%d@." (List.length v.Yacc.rules);
+  let sccs = Yacc.Rules.scc_list v.Yacc.rules in
+  List.iter (fun scc ->
+    match scc with
+    | [] -> ()
+    | [rule] when not (Yacc.Rule.is_direct_leftrec rule) -> ()
+    | _ ->
+        Format.eprintf "SCC %d: @[%a@]@."
+          (List.length scc)
+          (Format.list "@ "
+             (fun ppf rule -> Format.fprintf ppf "%s" rule.Yacc.Rule.nonterminal)) scc
+    ) sccs;
+
+  printf "(* header *)
+open Parsing
+open Token
+open Token.Parser
+open Planck
+open Plphelper
+@.";
+
+  printf "%s@." v.Yacc.header;
+  printf "(* /header *)@.@.";
+
+  printf "(* declarations *)@.";
+  (list "@,"
+       (fun ppf d -> 
+         match d with
+         | Yacc.Decl.Token (Some _, tkns) ->
+             List.iter (fun tkn ->
+               fprintf ppf "let get_%s = token_result (function (%s v) -> `Ok v | _ -> `Error \"expected %s\")@." tkn tkn tkn) tkns
+         | Yacc.Decl.Token (None, _tkns) -> ()
+         | _ -> fprintf ppf "(* %a *)@." (Sexplib.Sexp.pp_hum) (Yacc.Decl.sexp_of_t d);
+       )) stdout v.Yacc.decls;
+  printf "(* /declarations *)@.@.";
+
+  List.iter (function 
+    | Yacc.Decl.Token (typopt, tkns) -> 
+        List.iter (fun tkn -> Hashtbl.add tokens tkn typopt) tkns
+    | _ -> ()) v.Yacc.decls;
+
+  printf "(* rules *)@.@.";
+
+  printf "class rules = object (self)@.";
+
+  List.iter (fun r ->
+
+    match r.Yacc.Rule.leftrec with
+    | `Unknown -> assert false
+    | `NonRecursive ->
+
+        printf "  method %s = rule %S (fun () -> dummy@." r.Yacc.Rule.nonterminal r.Yacc.Rule.nonterminal;
+        List.iteri (fun i c ->
+          let ocaml_code, used_ids = replace_dollar_n c.Yacc.Rule.ocaml in
+          printf "    <!> case 1 \"%s_%d\" (fun () -> perform@." r.Yacc.Rule.nonterminal i;
+          printf "@.";
+          if c.Yacc.Rule.symbols = [] then printf "           (* empty *)@."
+          else
+            printf "           @[<v>%a@];@." 
+              (list ";@," (fun ppf (i,sym) -> symcode ppf false used_ids i sym))
+              (List.mapi (fun i sym -> (i+1,sym)) c.Yacc.Rule.symbols);
+          (match c.Yacc.Rule.prec with
+          | None -> ()
+          | Some sym -> printf "           (* %%prec %s *)@." sym);
+          printf "@.";
+          printf "           return (fun () -> %s))@.@." ocaml_code)
+          (List.sort Ocamlyacc.Rule.compare_case r.Yacc.Rule.cases);
+        printf "      )@.@.";
+             
+    | `Mutual _ | `NonMutual ->
+
+        printf "  method %s = leftrec %S self#%s_nonleftrec self#%s_leftrec@.@."
+          r.Yacc.Rule.nonterminal r.Yacc.Rule.nonterminal
+          r.Yacc.Rule.nonterminal r.Yacc.Rule.nonterminal;
+
+        printf "  method %s_nonleftrec = (dummy@." r.Yacc.Rule.nonterminal;
+        List.iteri (fun i c ->
+          let ocaml_code, used_ids = replace_dollar_n c.Yacc.Rule.ocaml in
+          printf "    <!> case 1 \"%s_nonleftrec_%d\" (fun () -> perform@." r.Yacc.Rule.nonterminal i;
+          printf "@.";
+          if c.Yacc.Rule.symbols = [] then printf "           (* empty *)@."
+          else
+            printf "           @[<v>%a@];@." 
+              (list ";@," (fun ppf (i,sym) -> symcode ppf false used_ids i sym))
+              (List.mapi (fun i sym -> (i+1,sym)) c.Yacc.Rule.symbols);
+          (match c.Yacc.Rule.prec with
+          | None -> ()
+          | Some sym -> printf "           (* %%prec %s *)@." sym);
+          printf "@.";
+          printf "           return (fun () -> %s))@.@." ocaml_code)
+          (List.sort Ocamlyacc.Rule.compare_case (List.filter (fun c -> c.Yacc.Rule.case_leftrec = `NonRecursive) r.Yacc.Rule.cases));
+        printf "      )@.@.";
+             
+        printf "  method %s_leftrec v_1 = (dummy@." r.Yacc.Rule.nonterminal;
+        List.iteri (fun i c ->
+          let ocaml_code, used_ids = replace_dollar_n c.Yacc.Rule.ocaml in
+          let is_case_mutual =
+            match c.Yacc.Rule.symbols with
+            | s::_ -> s <> r.Yacc.Rule.nonterminal
+            | _ -> false
+          in
+          if is_case_mutual then printf "(* MUTUAL LEFT REC @.";
+          printf "    <!> case 2 \"%s_leftrec_%d\" (fun () -> perform@." r.Yacc.Rule.nonterminal i;
+          printf "@.";
+          if is_case_mutual then begin
+            let symbols = c.Yacc.Rule.symbols in
+            if symbols = [] then printf "           (* empty *)@."
+            else
+              printf "           @[<v>%a@];@." 
+                (list ";@," (fun ppf (i,sym) -> symcode ppf false used_ids i sym))
+                (List.mapi (fun i sym -> (i+1,sym)) symbols);
+            (match c.Yacc.Rule.prec with
+            | None -> ()
+            | Some sym -> printf "           (* %%prec %s *)@." sym);
+            printf "@.";
+            printf "           return (fun () -> %s))@.@."
+              ocaml_code
+          end else begin
+            let symbols = List.tl c.Yacc.Rule.symbols in
+            if symbols = [] then printf "           (* empty *)@."
+            else
+              printf "           @[<v>%a@];@." 
+                (list ";@," (fun ppf (i,sym) -> symcode ppf false used_ids i sym))
+                (List.mapi (fun i sym -> (i+2,sym)) symbols);
+            (match c.Yacc.Rule.prec with
+            | None -> ()
+            | Some sym -> printf "           (* %%prec %s *)@." sym);
+            printf "@.";
+            printf "           return (fun () -> %s))@.@." 
+              ocaml_code
+          end;
+          if is_case_mutual then printf "*)@.")
+          (List.sort Ocamlyacc.Rule.compare_case (List.filter (fun c -> c.Yacc.Rule.case_leftrec <> `NonRecursive) r.Yacc.Rule.cases));
+        printf "      )@.@.";
+
+  ) v.Yacc.rules;
+
+  printf "end@.";
+    
+  printf "(* /rules *)@.@.";
+
+  printf "(* trailer *)@.%s@.(* /trailer *)@." v.Yacc.trailer
+
+let _ = Arg.parse [] (fun x ->
+  let ic = open_in x in
+  let stream = Input.Stream.from_chan ~filename:"" ic in
+  let v = parse stream in
+  close_in ic;
+  process v;
+  ) "ocamlyacctest files"
+
   | WITH
 with sexp
 
+type _token = t
+
 let equal a b = 
   let a_int = Obj.is_int (Obj.repr a) in
   let b_int = Obj.is_int (Obj.repr b) in
     | _ -> false
   else false
 
-type _token = t
 let show t = Sexplib.Sexp.to_string_hum (sexp_of_t t)
 
 module Stream = struct
 
-  module MemoKey = struct
-    type t = string
-    let hash = Hashtbl.hash
-    let equal (x : string) y = x = y
-  end
-
-(*
-  module Memo = Hashtbl.Make(MemoKey)
-*)
-
   module Base = struct
     module Elem = struct
       type t = _token
       let show = show
       let format ppf = Format.pp_print_string ppf ** show 
-      let equal = equal
-      let compare = compare
+      include Mtypes.Make_comparable(struct
+        type t = _token
+        let compare = compare
+      end)
     end
     module Pos = Position.Region
     module Attr = struct
     end
   end
 
-  module Str = Stream.Make(Base)
+  module Str = Pstream.Make(Base)
 
   include Str
 
   include Smemo.Extend(struct
     include Str
-(*
-    module Memo = Memo
-*)
     let memo = Base.Attr.memo
   end)
 
   let create (m : ('a option * Position.Region.t) Input.Parser.t) = fun st ->
     let rec f last_pos st = lazy begin
       match Input.Parser.run m st with
-      | Result.Ok ((None, pos), _st') -> null_desc (last_pos, pos, Smemo.create ()) (* EOS case *)
-      | Result.Ok ((Some v, pos), st') -> cons_desc v (last_pos, pos, Smemo.create ()) (f (Some pos) st')
-      | Result.Error (pos, s) -> raise (Input.Parser.Critical_error (pos, s))
+      | `Ok ((None, pos), _st') -> null_desc (last_pos, pos, Smemo.create ()) (* EOS case *)
+      | `Ok ((Some v, pos), st') -> cons_desc v (last_pos, pos, Smemo.create ()) (f (Some pos) st')
+      | `Error (pos, s) -> raise (Input.Parser.Critical_error (pos, s))
     end
     in
     f None st
 
 module Parser = struct
   include Pbase.Make(Stream)
-  let last_position : Position.Region.t t = perform
+
+  open Position
+
+  let last_position : Region.t t = perform
     st <-- stream;
-    return (match Stream.last_position st with
-      | Some reg -> reg
-      | None -> Position.Region.none)
+    return & match Stream.last_position st with
+             | Some reg -> reg
+             | None -> Region.none
 
   (** Efficient version of with_region *)
-  let with_region (t : 'a t) : ('a * Position.Region.t) t = perform
+  let with_region (t : 'a t) : ('a * Region.t) t = perform
     last_bot_pos <-- last_position;
     last_top_pos <-- position;
     res <-- t;
     let pos = 
       if last_top_pos = top_pos then 
         (* No advancement. OCaml's behaviour is: return the end of the last consumed position *)
-        { last_bot_pos with Position.Region.start = last_bot_pos.Position.Region.end_ }
+        { last_bot_pos with Region.start = last_bot_pos.Region.end_ }
       else
-        { Position.Region.start = last_top_pos.Position.Region.start; end_ = bot_pos.Position.Region.end_ }
+        { Region.start = last_top_pos.Region.start; 
+          end_ = bot_pos.Region.end_ }
     in
-    (* \ assert (Position.Region.is_valid pos); *)
+    (* \ assert (Region.is_valid pos); *)
     return (res, pos)
 end
+(*
+
+  Structure and analysis of Yacc rules
+
+*)
+
+open Spotlib.Spot
 open Sexplib.Conv
 
 module Rule = struct
   type t = {
-    nonterminal : string;
-    cases : case list;
+    nonterminal     : string;
+    cases           : case list;
     mutable leftrec : leftrec
   }
 
   and case = {
-    symbols : string list;
-    prec : string option;
-    ocaml : string ;
+    symbols              : string list;
+    prec                 : string option;
+    ocaml                : string ;
     mutable case_leftrec : leftrec
   } 
 
   let equal x y = x.nonterminal = y.nonterminal
 
   let is_direct_leftrec t =
-    List.mem t.nonterminal 
-      (List.concat (List.map (fun c -> 
+    List.mem t.nonterminal & List.concat & List.map (fun c -> 
         match c.symbols with
         | [] -> []
-        | x::_ -> [x]) t.cases))
+        | x::_ -> [x]) t.cases
 end
 
 (* leftrec mutual recursion analysis *)  
         | head::_ ->
             let r =
               try
-                Some (List.find (fun r -> r.Rule.nonterminal = head) rules )
+                Some (List.find (fun r -> r.Rule.nonterminal = head) rules)
               with
               | Not_found -> None
             in
   include Graph.Components.Make(G)
 
   let analyze rules = 
-    let scc_query = snd (scc rules) in
+    let scc_query = snd & scc rules in
     let sccs = scc_array rules in
     List.iter (fun r -> 
       let sccs = sccs.(scc_query r) in

opam/template/opam

-depends: ["ocamlfind" "sexplib" {>= "108.07.00"} "spotlib" {>= "2.1.2"} "omake"]
+depends: ["ocamlfind" "sexplib" {>= "108.07.00"} "spotlib" {>= "2.1.2"} "ocamlgraph" {>= "1.8.2"} "omake"]
 ocaml-version: [>= "4.00.1"]
 
   let rec show = function
     | Const n -> string_of_int n
-    | Binop (char, t1, t2) -> "(" ^ show t1 ^ " " ^ String.make 1 char ^ " " ^ show t2 ^ ")"
-    | Unop (char, t1) -> "(" ^ String.make 1 char ^ " " ^ show t1  ^ ")"
+    | Binop (char, t1, t2) ->
+        "(" ^ show t1 ^ " " ^ String.make 1 char ^ " " ^ show t2 ^ ")"
+    | Unop (char, t1) ->
+        "(" ^ String.make 1 char ^ " " ^ show t1  ^ ")"
 end
 
 module Op = Op_prec.Make(struct
   type t = Tree.t
   type op = char
   let show_op = Printf.sprintf "(%c)"
-  let app _f _a = assert false
+  let app _f _a      = assert false
   let binop op a1 a2 = Tree.Binop(op, a1, a2)
-  let unop op a1 = Tree.Unop(op, a1)
+  let unop op a1     = Tree.Unop(op, a1)
 end)
 
 let tbl = 
   ]
   
 (* parsing rules *)
-let blank = void (one_of [' '; '\t'; '\n'; '\r'])
+let blank = void & one_of [' '; '\t'; '\n'; '\r']
 
-let rec simple_expr st = (fun e -> e st) & 
+let rec simple_expr = fun st -> (|>) st & (* eta expansion *)
   
   (* Skip spaces *)
   ?* blank >>= fun () -> 
   constant
 
   <|> (tokenp (function '+' | '-' | '*' | '/' | '~' -> true | _ -> false)
-         >>= fun char -> return (`Op (Hashtbl.find tbl char, char) ))
+         >>= fun char -> return & `Op (Hashtbl.find tbl char, char))
 
   <|> (token '(' >>= fun () ->
        expr >>= fun e ->
        ?* blank >>= fun () ->
        token ')' >>= fun () -> 
-       return (`Term e))
+       return & `Term e)
 
-and constant st = begin
+and constant = fun st -> (|>) st & (* eta expansion *)
   (* [0-9]+ *)
   matched (?+ (tokenp (function '0'..'9' -> true | _ -> false) <?> "decimal")) 
-  >>= fun s -> return (`Term (Tree.Const (int_of_string s)))
-end st
+  >>= fun s -> return & `Term (Tree.Const (int_of_string s))
 
-and expr st = begin
+and expr = fun st -> (|>) st & (* eta expansion *)
   option (token '-') >>= fun unary_minus ->
   ?++ simple_expr >>= fun es -> 
   match unary_minus with
-  | Some () -> return (Op.parse (`Op (Hashtbl.find tbl '~', '~') :: es))
-  | None -> return (Op.parse es)
-end st
+  | Some () -> return & Op.parse (`Op (Hashtbl.find tbl '~', '~') :: es)
+  | None -> return & Op.parse es
 
 (* For test *)
 
 let rec random size = 
   let key = if size = 0 then 0 else Random.int 6 in
   match key with
-  | 0 -> string_of_int (Random.int 10)
+  | 0 -> string_of_int & Random.int 10
   | 1 -> "(- " ^ random (size-1)  ^ ")" (* unary minus is different from ocaml *)
   | 2 -> "(" ^ random (size-1) ^ ")"
   | 3 -> random (size-1) ^ " + " ^ random (size-1)
   | `Ok (res, _) -> 
       (* Check whether the original and parsed are identical *)
       (* Check of computed values are done outside of this program. See OMakefile. *)
-      Format.eprintf "%s@." (Tree.show res);
+      Format.eprintf "%s@." & Tree.show res;
       let n = Tree.eval res in
       Format.printf "assert (%s = %d);;@." s n;
 
       Format.eprintf "%a: syntax error: %s@." Position.File.format pos s;
       raise Exit
 
-let _ = 
+let () = 
   for _i = 0 to 100 do
-    test (random 20)
-  done;
+    test & random 20
+  done
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.